Hi,
This is the edx macro..
'*****************************************************************************************
'*
'* R E L O A D E D X
'*
'*****************************************************************************************
Sub RunTask
tp = MsgBox("Are you sure?", 1)
if tp=2 then
exit sub
end if
CONST SUCCESS = 0
CONST TASKNOTFOUND = 1
CONST TASKISALREADYRUNNING = 2
CONST NOEDXTRIGGERFOUND = 3
CONST OTHERERROR = 9
CONST WAITING = 0
CONST RUNNING = 90
CONST FINISHEDWITHWARNINGS = 91
CONST FINISHEDWITHERRORS = 92
dim xmlHttp
set xmlHttp = CreateObject("Microsoft.XMLHTTP")
set xml = createobject("Microsoft.XMLDOM")
set xmlObj = createobject("Microsoft.XMLDOM")
'***********************************************************************
' This ROWS must be modified
'***********************************************************************
url = "http://localhost:4780/qtxs.asmx"
doc = "reloadvictim.qvw"
userID = "optima.test"
pass = "rocpsgvtdice123"
'***********************************************************************
ITERATIONS=10000
DELAY=30
METHOD = "<Global method=""RequestEDX"" key=""" & GetTimeLimitedRequestKey(url, doc, userID, pass) & """>"
METHOD = METHOD & "<i_TaskIDOrTaskName>" & doc & "</i_TaskIDOrTaskName>"
METHOD = METHOD & "<i_Password>" & pass & "</i_Password>"
METHOD = METHOD & "<i_VariableName>vCond</i_VariableName><i_VariableValueList><string>1</string></i_VariableValueList>"
METHOD = METHOD & "</Global>"
DIM AsAt
AsAt = Now()
' Submit request to the QDS via HTTP
xmlHttp.open "POST",url,false, userID, pass
xmlHttp.setRequestHeader "Content-Type","text/xml"
xmlHttp.setRequestHeader "Content-Length", Len(METHOD)
xmlHttp.Send METHOD
select case xmlHttp.Status
case 200:
' Load the Response into an XML object
xml.async = false
xml.loadXML(xmlHttp.responseText)
' Parse the XML Response extracting Status, Log, etc
TaskStartResult = ""
set xmlObj = xml.SelectNodes("//RequestEDX/RequestEDXResult/*")
for node = 0 to (xmlObj.length -1)
select case xmlObj.item(node).nodeName
case "TaskStartResult":
TaskStartResult = xmlObj.item(node).text
select case TaskStartResult
case "Success":
TaskStartResultCode = SUCCESS
case "TaskNotFound":
TaskStartResultCode = TASKNOTFOUND
case "TaskIsAlreadyRunning":
TaskStartResultCode = TASKISALREADYRUNNING
case "NoEDXTriggerFound":
TaskStartResultCode = NOEDXTRIGGERFOUND
case "OtherError":
TaskStartResultCode = OTHERERROR
case else
TaskStartResultCode = OTHERERROR
end select 'TaskStartResult
RC = TaskStartResultCode
case "TaskStartResultCode":
select case xmlObj.item(node).text
case "0":
TaskStartResultCode = SUCCESS
case "1":
TaskStartResultCode = TASKNOTFOUND
case "2":
TaskStartResultCode = TASKISALREADYRUNNING
case "3":
TaskStartResultCode = NOEDXTRIGGERFOUND
case "9":
TaskStartResultCode = OTHERERROR
case else
TaskStartResultCode = OTHERERROR
end select 'TaskStartResultCode
RC = TaskStartResultCode
case "Log":
Message = Split( xmlObj.item(node).text, chr(9))
end select 'nodeName
next 'iteration
case 401:
msgbox "ERROR: The credentials for QDS (" & url & ") are incorrect."
exit sub
case 403:
msgbox "ERROR: User is not authorised to request EDX tasks."
exit sub
case 404:
msgbox "ERROR: The URL for QDS (" & url & ") is incorrect."
exit sub
case 503:
msgbox "ERROR: The QDS (" & url& ") is unavailable."
exit sub
case 12029:
msgbox "ERROR: The QDS (" & url & ") is not accessible."
exit sub
case else
msgbox "ERROR: An error (" & xmlHttp.Status & ") occurred trying to access the QDS."
end select 'xmlHttp
'-----------------------------------------------------------------------------
'- GetTaskStatus
'-----------------------------------------------------------------------------
i = 0
Finished = False
WAIT = true
do while (TaskStartResultCode = SUCCESS) AND (WAIT = True) AND (i < ITERATIONS) AND Finished=False
' sleep( DELAY * 1000)
METHOD = "<Global method=""GetTaskStatus"" key=""" & GetTimeLimitedRequestKey(url, doc, userID, pass) & """>"
METHOD = METHOD & "<TaskNameOrId>" & doc & "</TaskNameOrId>"
METHOD = METHOD & "</Global>"
AsAt = Now()
' Submit request to the QDS via HTTP
xmlHttp.open "POST",url,false, userID, pass
xmlHttp.setRequestHeader "Content-Type","text/xml"
xmlHttp.setRequestHeader "Content-Length", Len(METHOD)
xmlHttp.Send METHOD
'
select case xmlHttp.Status
case 200:
xml.async = false
xml.loadXML(xmlHttp.responseText)
set xmlObj = xml.SelectNodes("//GetTaskStatus/GetTaskStatusResult/TaskStatus/*")
for node = 0 to (xmlObj.length -1)
select case xmlObj.item(node).nodeName
case "Status":
GetTaskStatus = xmlObj.item(node).text
select case GetTaskStatus
case "Waiting":
Finished = True
RC = WAITING
Msgbox AsAt & chr(9) & "[Waiting.........]"
case "Running":
Finished = False
RC = RUNNING
Msgbox AsAt & chr(9) & "[Waiting.........]"
case "FinishedWithWarnings":
Finished = True
RC = FINISHEDWITHWARNINGS
Msgbox AsAt & chr(9) & "[" & GetTaskStatus & "]"
case "FinishedWithErrors":
Finished = True
RC = FINISHEDWITHERRORS
Msgbox AsAt & chr(9) & "[" & GetTaskStatus & "]"
case else
Finished = True
RC = OTHERERROR
Msgbox AsAt & chr(9) & "[Errore!]"
end select
case "LastLogMsg":
LastLogMsg = xmlObj.item(node).text
if ShowMessages = True then
Msgbox " "
Msgbox LastLogMsg
Msgbox " "
end if
end select 'nodeName
next 'node
case 401:
Msgbox "ERROR: The credentials for QDS (" & url & ") are incorrect."
exit sub
case 403:
Msgbox "ERROR: User is not authorised to Get Task Status....."
exit sub
case 404:
Msgbox "ERROR: The URL for QDS (" & url & ") is incorrect."
exit sub
case 503:
Msgbox "ERROR: The QDS (" & url & ") is unavailable."
exit sub
case 12029:
Msgbox "ERROR: The QDS (" & url & ") is not accessible."
exit sub
case else
Msgbox "ERROR: An error (" & xmlHttp.Status & ") occurred trying to access the QDS."
exit sub
end select
i = i + 1
Loop
xmlObj = null
xml = null
xmlHttp = null
end sub
'-----------------------------------------------------------------------------
'- GetTimeLimitedRequestKey
'-----------------------------------------------------------------------------
Function GetTimeLimitedRequestKey(dsURL, document, userID, password)
set xmlHttp = CreateObject("Microsoft.XMLHTTP")
set xml = createobject("Microsoft.XMLDOM")
set xmlObj = createobject("Microsoft.XMLDOM")
DIM METHOD '
METHOD ="<Global method=""GetTimeLimitedRequestKey"" />"
xmlHttp.open "POST",dsURL,false, userID, password
xmlHttp.setRequestHeader "Content-Type","text/xml"
xmlHttp.setRequestHeader "Content-Length", Len(METHOD)
xmlHttp.Send METHOD
select case xmlHttp.Status
case 200:
xml.async = false
xml.loadXML(xmlHttp.responseText)
set xmlObj = xml.SelectNodes("//GetTimeLimitedRequestKey")
for node = 0 to (xmlObj.length -1)
if xmlObj.item(node).nodeName = "GetTimeLimitedRequestKey" then
GetTimeLimitedRequestKey = xmlObj.item(node).text
end if
next 'node
case 401:
msgbox "ERROR: The credentials for QDS (" & dsURL & ") are incorrect."
exit function
case 403:
msgbox "ERROR: User is not authorised to interact with QDS."
exit function
case 404:
msgbox "ERROR: The URL for QDS (" & dsURL & ") is incorrect."
exit function
case 503:
msgbox "ERROR: The QDS (" & dsURL & ") is unavailable."
exit function
case 12029:
msgbox "ERROR: The QDS (" & dsURL & ") is not accessible."
exit function
case else
msgbox "ERROR: An error (" & xmlHttp.Status & ") occurred trying to access the QDS."
end select
End Function
Sub Rld
Call RunTask
End Sub
