1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
|
Option Explicit
Dim WithEvents OPCMyserver As OPCServer 'OPC Server object
Dim WithEvents OPCMygroups As OPCGroups 'OPC Group object collection
Dim WithEvents OPCMygroup As OPCGroup 'OPC Group object
Dim OPCMyitems As OPCItems 'OPC Item object collection
Dim OPCMyitem As OPCItem 'OPC Item object
Dim OPCMyBrowser As OPCBrowser 'OPC Browser object
Dim ItemServerHandles() As Long 'OPC Item Handle
Dim ClientHandles(1) As Long 'OPC Client Handle
Dim OPCItemIDs(1) As String 'OPC Item ID
Dim Errors() As Long 'OPC Item Errors
'Dim NombreItem As Integer 'Ne sert a rien pour l'instant
Dim BrowseLevel As Integer 'Current level in the OPC Browser
Dim ConnectFlag As Boolean 'If connection established, ConnectFlag = True, Else = False
Private Sub Form_Load()
Dim Getserver As OPCServer 'Useful to count and store the OPC servers set up on the computer
Dim Servers As Variant 'Array which contains all the OPC servers set up on the computer
Dim I As Integer 'Index of the previous array
With lvOPCitems 'Initializing of the ListView, 4 labelled collumns
.ColumnHeaders.Add , , "Item", .Width * 30 / 100
.ColumnHeaders.Add , , "Value", .Width * 20 / 100
.ColumnHeaders.Add , , "TimeStamp", .Width * 20 / 100
.ColumnHeaders.Add , , "Quality", .Width * 20 / 100
End With
cboOPC_Servers.Clear 'Erase the OPC servers combo box
Set Getserver = New OPCServer 'We ceate an OPC server objet instance
Servers = Getserver.GetOPCServers 'We get all the OPC servers set up on the computer
For I = LBound(Servers) To UBound(Servers) 'We add all the OPC servers found on the computer to the combo box
cboOPC_Servers.AddItem Servers(I)
Next I
Set Getserver = Nothing 'We clear the created OPC server object
cboOPC_Servers.ListIndex = 0 'We show the fisrt OPC server found in the combo box
lblServer.Caption = cboOPC_Servers.List(0) 'We show the OPC server selected
If lblServer.Caption = "" Then 'If no OPC server found, we display an Error MsgBox
MsgBox "Impossible to find an active OPC server", vbOKOnly + vbExclamation
End If
txtRefTime.Text = "1000" 'Value of the refresh time
End Sub
Private Sub cmdAddItem_Click()
Dim I As Integer
lvOPCitems.ListItems.Add , , txtPosition.Text 'We had to the list View the name of a new OPC Item
For I = 1 To lvOPCitems.ListItems.Count 'We add all the OPC Items of the ListView to the Collection of OPC Items
OPCItemIDs(1) = lvOPCitems.ListItems(I)
OPCMyitems.AddItems 1, OPCItemIDs, ClientHandles, ItemServerHandles, Errors
Next I
End Sub
Private Sub cmdAutoRead_Click()
OPCMygroup.IsActive = Not OPCMygroup.IsActive 'Necessary to refresh data
OPCMygroup.IsSubscribed = Not OPCMygroup.IsSubscribed 'Necessary to refresh data
OPCMygroup.UpdateRate = Val(txtRefTime.Text) 'Use the refresh time
If OPCMygroup.IsActive = False Then 'When the group is Not Active, we can start the auto read and change the refresh time value
cmdAutoRead.Caption = "Auto Read On"
txtRefTime.Enabled = True
Else 'When the group is Active, we can stop the auto read but we can't change the refresh time value
cmdAutoRead.Caption = "Auto Read Off"
txtRefTime.Enabled = False
Call cmdRead_Click
End If
End Sub
Private Sub cmdRead_Click()
Dim anItem As OPCItem
Dim I As Integer
On Error Resume Next
For I = 1 To lvOPCitems.ListItems.Count 'For all the items in the ListView
For Each anItem In OPCMygroup.OPCItems 'For all OPC Items
anItem.Read OPCDevice 'Read the item, and the Item Id is the same than the current name in the ListView...
If anItem.ItemID = lvOPCitems.ListItems(I) Then
lvOPCitems.ListItems(I).SubItems(1) = anItem.Value '...get the Item Value...
lvOPCitems.ListItems(I).SubItems(2) = anItem.TimeStamp '...get the Item TimeStamp...
lvOPCitems.ListItems(I).SubItems(3) = anItem.Quality '...get the Item Quality
Exit For
End If
Next anItem
Next I
Set anItem = Nothing 'clear the Item
End Sub
Private Sub cboOPC_Servers_Click()
'Displaying of the current OPC server
lblServer.Caption = cboOPC_Servers.List(cboOPC_Servers.ListIndex)
End Sub
Private Sub cmdConnect_Click()
Dim vName As Variant
If ConnectFlag = False Then 'If we are not connected
On Error GoTo ConnectError
Set OPCMyserver = New OPCServer
OPCMyserver.Connect lblServer.Caption 'We try to connect to OPC server
Set OPCMygroups = OPCMyserver.OPCGroups 'We load the OPC Groups
Set OPCMygroup = OPCMygroups.Add("Group_1") 'We add a group, the name is not important
Set OPCMyitems = OPCMygroup.OPCItems 'We load the OPC Items located in the OPC Group
Set OPCMyBrowser = OPCMyserver.CreateBrowser 'For the navigation in the OPC server
OPCMyBrowser.ShowBranches
For Each vName In OPCMyBrowser 'All the Variant are displayed with "+"
ListDevice.AddItem "+" + vName
Next vName
txtPosition.Text = Mid$(ListDevice.List(0), 2) 'We display the first device found
If txtPosition.Text = "" Then 'If there is no device
OPCMyserver.Disconnect 'We dicsonnect, we clear objects, and we display a MsgBox
Set OPCMyserver = Nothing
Set OPCMyBrowser = Nothing
MsgBox "Can't find OPC device", vbOKOnly + vbExclamation
Exit Sub
End If
ConnectFlag = True 'We are now connected
cmdConnect.Caption = "Disconnect"
BrowseLevel = 0 'Initializing of the position in the OPC server
OPCMygroup.IsActive = False
Else
On Error Resume Next
OPCMygroup.IsActive = False
OPCMygroups.Remove OPCMygroup.ServerHandle
Set OPCMyitems = Nothing 'Delete Item collection
Set OPCMyitem = Nothing 'Delete Item object
Set OPCMygroups = Nothing 'Delete Group collection
Set OPCMygroup = Nothing 'Delete Group object
Set OPCMyBrowser = Nothing
OPCMyserver.Disconnect 'Diconnection
Set OPCMyserver = Nothing 'clear the OPC server object
ConnectFlag = False 'We are not connected anymore
cmdConnect.Caption = "Connect to OPC Server"
ListDevice.Clear
lvOPCitems.ListItems.Clear 'clear the ListView
End If
Exit Sub
ConnectError:
MsgBox "Error Connecting", vbOKOnly + vbExclamation
End Sub
Private Sub cmdDown_Click()
'Go down in the tree
'___________________
Dim vName As Variant
If Left$(ListDevice.Text, 1) = "+" Then 'If the device contains Items....
vName = Mid$(ListDevice.Text, 2)
Else
Exit Sub 'If not, we leave
End If
OPCMyBrowser.MoveDown (vName) '...we move down in the browser
ListDevice.Clear
OPCMyBrowser.ShowBranches 'We get the branches of the tree at the "vname" location
For Each vName In OPCMyBrowser
ListDevice.AddItem "+" + vName
Next vName
OPCMyBrowser.ShowLeafs 'We get the leaves of the tree at the "vname" location
For Each vName In OPCMyBrowser
ListDevice.AddItem vName
Next vName
BrowseLevel = BrowseLevel + 1 'Current level in the tree
End Sub
Private Sub cmdUp_Click()
'Go Up in the tree
'_________________
Dim vName As Variant
If BrowseLevel = 0 Then Exit Sub 'If tree's top,nothing to do
OPCMyBrowser.MoveUp 'Else, we move up in the browser
ListDevice.Clear
OPCMyBrowser.ShowBranches 'We get the branches of the tree at the "vname" location
For Each vName In OPCMyBrowser
ListDevice.AddItem "+" + vName
Next vName
OPCMyBrowser.ShowLeafs 'We get the leaves of the tree at the "vname" location
For Each vName In OPCMyBrowser
ListDevice.AddItem vName
Next vName
BrowseLevel = BrowseLevel - 1 'Current level in the tree
End Sub
Private Sub ListDevice_Click() 'Displaying the right format when we choose an Item in the tree
Dim vName As Variant
On Error GoTo ErrorOccured
If Left$(ListDevice.Text, 1) = "+" Then
vName = Mid$(ListDevice.Text, 2)
Else
vName = ListDevice.Text
End If
txtPosition.Text = OPCMyBrowser.GetItemID(vName)
ErrorOccured:
Exit Sub
End Sub
Private Sub ListDevice_DblClick()
'Go down in the tree
'___________________
Call cmdDown_Click 'When you dbl click on an item, it has the same consequences that using the cmdDown button
End Sub
'Every time one of the data of the subscribed group has changed we refresh all the data of the data
Private Sub OPCMygroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
Dim anItem As OPCItem
Dim I As Integer
Dim FileName As String
On Error Resume Next
For I = 1 To lvOPCitems.ListItems.Count
For Each anItem In OPCMygroup.OPCItems
anItem.Read OPCDevice
If anItem.ItemID = lvOPCitems.ListItems(I) Then
lvOPCitems.ListItems(I).SubItems(1) = anItem.Value
lvOPCitems.ListItems(I).SubItems(2) = anItem.TimeStamp
lvOPCitems.ListItems(I).SubItems(3) = anItem.Quality
FileName = lvOPCitems.ListItems(I) & ".txt"
Open FileName For Append As #1
Write #1, lvOPCitems.ListItems(I), lvOPCitems.ListItems(I).SubItems(1), lvOPCitems.ListItems(I).SubItems(2), lvOPCitems.ListItems(I).SubItems(3)
Close 1
Exit For
End If
Next anItem
Next I
Set anItem = Nothing
End Sub
Private Sub OPCMyserver_ServerShutDown(ByVal Reason As String)
MsgBox "Server Shutdown", , vbOKOnly + vbExclamation 'If the server shutdown during the connection
End Sub
Private Sub cmdExit_Click()
'Exit the Application
If ConnectFlag = True Then
Call cmdConnect_Click
End If
End
End Sub |
changement de code vers vbscript
Répondre avec citation
Partager