salut a tout,
j'ai un code en vb6, je veux le changer en vbscript pour intégrer avec html.
quelqu'un peut m'aider?
le code de vb6 est le suivant:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Cordialement