'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()

'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"