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
'Enum CxValueType
    Const typeDouble = 3
    Const typeLong = 2
    Const typeString = 1
 
'Enum CxTimeStampType
    Const typeFILETIME = 1
    Const typeUTC = 2
 
Dim CvsL,CvsR,res,GetReq,GetReqResp,RtREx, SetRtrExReq, objRtrEx
Dim Rval,Lvali,Lvalii,resii

' CxCvs Objects
Set CvsL = CreateObject("CxCvs.CvsClient")
Set CvsR = CreateObject("CxCvs.CvsClient")
Set GetReq = CreateObject("CxCvsLib.GetNamedRtRexReq")
Set GetReqResp = CreateObject("CxCvsLib.GetNamedRtRExResp")
Set RtREX = CreateObject("CxCvsLib.RtREx")
Set SetRtrExReq = CreateObject("CxCvsLib.SetRtRExReq")
Set objRtrEx = CreateObject("CxCvsLib.RtrEx")
Dim objCvsClient : Set objCvsClient = CreateObject("CxCvsLib.CvsClient")
 
Dim strSITE : strSITE = "[5410]MYSITE.UIS"
Dim strLongPoint : strLongPoint = "RD_SYCMDSTAT"
Dim dblValue : dblValue = 0.0
Dim datTimeStamp : datTimeStamp = Now()
Dim intStatus : intStatus = 0
 
Sub  CxCvsExample1()
 
    ' Connect to a remote UIS
     
    res = CvsR.Connect(strSITE)
     
    If(Not res)Then ' 0 is "Connected"
     
        ' We're connected, so let's go
        ' We're grabbing a single value (1 value)
        GetReq.Count = 1
        GetReq.PointIdLong(0) = strLongPoint
        GetReq.TimeStampType = typeUTC
         
        res = CvsR.GetNamedRtREx(GetReq,GetReqResp)
         
        If(Not res)Then ' 0 is "Success"
         
            dblValue = GetReqResp.RtRex(0).Value
            datTimeStamp = GetReqResp.RtREx(0).TimeStamp
            intStatus = GetReqResp.RtREx(0).Status
            
            ' you could do whatever you want with these variables...
            MsgBox "Point = " & CStr(strLongPoint) & vbCrLf & "Value = " & CStr(dblValue) & vbCrLf & "TimeStamp = " & CStr(datTimeStamp) & vbCrLf & "Status = " & CStr(intStatus)
 
        Else
         
            MsgBox "Failed to grab the value..."
         
        End If
         
    Else
 
        MsgBox "Failed to connect to service...exiting"
        Exit Sub
 
    End If
 
        MsgBox "Done with example 1"
 
End Sub
 
Call CxCvsExample1()

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
'Enum CxValueType
    Const typeDouble = 3
    Const typeLong = 2
    Const typeString = 1
 
'Enum CxTimeStampType
    Const typeFILETIME = 1
    Const typeUCT = 2
 
Dim objCvsClient
Set objCvsClient = CreateObject("CxCvsLib.CvsClient")

On Error Resume Next
Dim iRet
'iRet = objCvsClient.Connect("[5411]MYSITE.UIS")
'iRet = objCvsClient.Connect("[5410]WESC.UIS")
iRet = objCvsClient.Connect("[5410]MYSITE.UIS")
 
If Err.Number <> 0 Then
    WScript.Echo "Connect error: " & Err.Description
Else
 
    Dim arrPointIdLong
'    arrPointIdLong = Array("100_AAAA", "90210_WCOND", "90210_WFEELSLK", "90210_WLOC")
 
    arrPointIdLong = Array("RD_SYCMDSTAT", "RD_SYCSAPRT")
     
    On Error Goto 0
     
    Dim setRtrExReq
    Set setRtrExReq = CreateObject("CxCvsLib.SetRtRExReq")
     
    setRtrExReq.TimeStampType = typeUCT
     
    Dim objRtrEx
    Set objRtrEx = CreateObject("CxCvsLib.RtrEx")
     
    Const iVALUE_CNT = 10000
    Dim iValueStep
     
    Dim iRecordCount : iRecordCount = 0
     
    Dim strLongId
    For Each strLongId In arrPointIdLong
 
        objRtrEx.PointIdLong = strLongId
         
        For iValueStep = 1 To iVALUE_CNT
            Dim strValue
            strValue = FormatCygNetValue(iValueStep, 2)
             
            objRtrEx.Status = 3    ' status of 3 sets the "updated" and "initialized" bits
            objRtrEx.UserStatus = 0
             
            ' not setting the time results in current client time to the millisecond
            'objRtrEx.TimeStampType = typeUCT
            'objRtrEx.TimeStamp = Now()
             
            objRtrEx.ValueType = typeString
            objRtrEx.Value = strValue
             
            setRtrExReq.RtrEx(iRecordCount) = objRtrEx
             
            iRecordCount = iRecordCount + 1
            setRtrExReq.RecordCount = iRecordCount
             
            If iRecordCount >= setRtrExReq.Count Then
                Call SendValues(setRtrExReq)
                iRecordCount = 0
            End If
        Next
         
    Next
    
    If iRecordCount > 0 Then
        Call SendValues(setRtrExReq)
        iRecordCount = 0
    End If
 
End If
 
Function FormatCygNetValue(dValue, iDecimalPlaces)
    Dim strValuePad : strValuePad = "                " ' 16 spaces
     
    Dim strCygNetValue
    strCygNetValue = FormatNumber(dValue, iDecimalPlaces, False, False, False)
     
    strCygNetValue = _
        Left(strValuePad, Len(strValuePad)-Len(strCygNetValue)) & strCygNetValue
     
    FormatCygNetValue = strCygNetValue
    End Function
 
Function SendValues(ByRef setRtrExReq)
    SendValues = True
 
    Dim setRtrExResp
    Set setRtrExResp = CreateObject("CxCvsLib.SetRtRExResp")
     
    Dim iRetryCount : iRetryCount = 10
     
    Do While iRetryCount > 0
        iRet = objCvsClient.SetRtREx(setRtrExReq, setRtrExResp)
         
        If iRet = 0 and setRtrExResp.Error = 11001 Then
            ' CVS setpoint queue is full so give it a chance to drain
            iRetryCount = iRetryCount -1
            WScript.Echo "SetPoint queue full (" & iRetryCount & ")"
            WScript.Sleep 100
        Else
            iRetryCount = 0
        End If
    Loop
 
    If iRet <> 0 Or setRtrExResp.Error <> 0 Then
        SendValues = False
         
        'WScript.Echo "SetRtREx error: " & iRet & ", " & setRtrExResp.Error
         
        Dim iPointErrorStep
        For iPointErrorStep = 0 To setRtrExResp.Count-1
            If setRtrExResp.PointError(iPointErrorStep) <> 0 Then
            'WScript.Echo "SetRtREx point(" & iPointErrorStep & ") error: " & setRtrExResp.PointError(iPointErrorStep)
            End If
        Next
    End If
End Function
 
MsgBox "Done"