VBScript BO Tools.vb

'boPost(BusinessObject, XMLParam, XMLDoc, KeyNode)
'Function boGetValues(sXmlOut, sNode)
'Function boLogBusinessObject(sType, sKey, sXMLParam, sXMLDoc, sXMLOut)

'Syspro WCF Service REST Address
Dim Wcf
Wcf = "http://localhost:20000/SysproWCFservice/REST/"

Public sBoError
Public sBoXmlOut

Function boPostSilent(BusinessObject, XMLParam, XMLDoc, KeyNode)
	Dim KeyValue	
	KeyValue = boPostActual(BusinessObject, XMLParam, XMLDoc, KeyNode, true)
	boPostSilent = KeyValue
End Function

Function boPost(BusinessObject, XMLParam, XMLDoc, KeyNode)	
	Dim KeyValue	
	KeyValue = boPostActual(BusinessObject, XMLParam, XMLDoc, KeyNode, false)
	boPost = KeyValue
End Function

Function boPostActual(BusinessObject, XMLParam, XMLDoc, KeyNode, Silent)	
	sBoError = ""
	sBoXmlOut = ""

	Dim XMLOut
	on error resume next

	If bDebug Then 
		boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, "Before Posting" 
	End If 

	XMLOut = CallTrn(BusinessObject,XMLParam,XMLDoc,"Post","auto")
	XMLOut = REPLACE(REPLACE(REPLACE(XMLOut, "<?xml version=""1.0"" encoding=""Windows-1252""?>", ""),"<>",""),"</>","")

	If bDebug Then 
		MsgBox XMLOut ,,"boPost.CallTrn"
	End If 

	if err then
		boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, XMLOut
		If not Silent Then
			msgbox err.Number & " - " & err.Description, vBCritical, "Calling Business Object"
		End If
		exit function
	end if
	' Switch on error handling
	on error goto 0
	boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, XMLOut	

	sBoXmlOut = XMLOut
	If InStr(XMLOut, "ErrorDescription") > 0 Then
		sBoError = boGetValues(XMLOut,"ErrorDescription", true)
		If not Silent Then
			MsgBox sBoError, 16, "Error Posting Business Object"
		End If
	End If

	boPostActual = boGetValues(XMLOut, KeyNode, false)	
End Function

Function boSetupSilent(BusinessObject, Method, XMLParam, XMLDoc, KeyNode)
	Dim KeyValue	
	KeyValue = boSetupActual(BusinessObject, Method, XMLParam, XMLDoc, KeyNode, true)
	boSetupSilent = KeyValue
End Function

Function boSetup(BusinessObject, Method, XMLParam, XMLDoc, KeyNode)	
	Dim KeyValue	
	KeyValue = boSetupActual(BusinessObject, Method, XMLParam, XMLDoc, KeyNode, false)
	boSetup = KeyValue
End Function

Function boSetupActual(BusinessObject, Method, XMLParam, XMLDoc, KeyNode, Silent)	
	sBoError = ""
	sBoXmlOut = ""

	Dim XMLOut
	on error resume next

	If bDebug Then 
		boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, "Before Posting" 
	End If 

	XMLOut = CallSetup(BusinessObject,XMLParam,XMLDoc,Method,"auto")
	'XMLOut = CallTrn(BusinessObject,XMLParam,XMLDoc,"Post","auto")
	XMLOut = REPLACE(REPLACE(REPLACE(XMLOut, "<?xml version=""1.0"" encoding=""Windows-1252""?>", ""),"<>",""),"</>","")

	If bDebug Then 
		MsgBox XMLOut ,,"boSetup.CallSetup"
	End If 

	if err then
		boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, XMLOut
		If not Silent Then
			msgbox err.Number & " - " & err.Description, vBCritical, "Calling Business Object"
		End If
		exit function
	end if
	' Switch on error handling
	on error goto 0
	boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, XMLOut	

	sBoXmlOut = XMLOut
	If InStr(XMLOut, "ErrorDescription") > 0 Then
		sBoError = boGetValues(XMLOut,"ErrorDescription", true)
		If not Silent Then
			MsgBox sBoError, 16, "Error Posting Business Object"
		End If
	End If

	boSetupActual = boGetValues(XMLOut, KeyNode, false)	
End Function

Function boQuerySilent(BusinessObject, XMLDoc)
	boQuerySilent = boQueryActual(BusinessObject, XMLDoc, true)
End Function

Function boQuery(BusinessObject, XMLDoc)
	boQuery = boQueryActual(BusinessObject, XMLDoc, false)
End Function

Function boQueryActual(BusinessObject, XMLDoc, Silent)
	sBoError = ""
	sBoXmlOut = ""

	Dim XMLOut
	on error resume next

	XMLOut = CallBO(BusinessObject,XMLDoc,"auto")
	XMLOut = REPLACE(REPLACE(REPLACE(XMLOut, "<?xml version=""1.0"" encoding=""Windows-1252""?>", ""),"<>",""),"</>","")

	If bDebug Then 
		MsgBox XMLOut ,,"boQueryActual.CallBO"
	End If 

	if err then
		If not Silent Then
			msgbox err.Number & " - " & err.Description, vBCritical, "Calling Business Object"
		End If
		exit function
	end if
	' Switch on error handling
	on error goto 0

	sBoXmlOut = XMLOut
	If InStr(XMLOut, "ErrorDescription") > 0 Then
		sBoError = boGetValues(XMLOut,"ErrorDescription", true)
		If not Silent Then
			MsgBox sBoError, 16, "Error Posting Business Object"
		End If
	End If

	boQueryActual = XMLOut
End Function

Function boCallWcfSilent(sClass, sMethod, BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass)
	Dim KeyValue	
	KeyValue = boPostWcfActual(sClass, sMethod, BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass, true)
	boCallWcfSilent = KeyValue
End Function

Function boCallWcf(sClass, sMethod, BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass)	
	Dim KeyValue	
	KeyValue = boPostWcfActual(sClass, sMethod, BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass, false)
	boCallWcf = KeyValue
End Function

Function boPostWcfSilent(BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass)
	Dim KeyValue	
	KeyValue = boPostWcfActual("Transaction", "Post", BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass, true)
	boPostWcfSilent = KeyValue
End Function

Function boPostWcf(BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass)
	Dim KeyValue	
	KeyValue = boPostWcfActual("Transaction", "Post", BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass, false)
	boPostWcf = KeyValue
End Function

Function boPostWcfActual(sClass, sMethod, BusinessObject, XMLParam, XMLDoc, KeyNode, Operator, OperatorPassword, CompanyId, CompanyPass, Silent)
	sBoError = ""
	sBoXmlOut = ""

	Dim XMLOut
	on error resume next

	If bDebug Then 
		boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, "Before Posting" 
	End If 

	'############################3
	Dim xmlhttp, URL
	Randomize
	Dim sGUID
	URL = Wcf & "Logon?Operator=" & Operator & "&OperatorPassword=" & OperatorPassword & "&CompanyId=" & CompanyId & "&CompanyPass=" & CompanyPass
	URL = URL & "&Random=" & CSTR(RND)
	'On Error Resume Next
	Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
	xmlhttp.open "GET", Url, False
	xmlhttp.send ""
	sGUID = xmlhttp.responseText           
	Set xmlhttp = Nothing
	URL = Wcf & sClass & "/" & sMethod & _
		"?UserId=" & sGUID & _
		"&BusinessObject=" & BusinessObject & _
		"&XmlIn=" & XMLDoc
	if not (XMLParam = "") then
		URL = URL & "&XMLParameters=" & XMLParam
	end if
	URL = URL & "&Random=" & CSTR(RND)
	Set xmlhttp = CreateObject("MSXML2.XMLHTTP")              
	xmlhttp.open "GET", Url, False                  
	'xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	xmlhttp.send ""
'MsgBox xmlhttp.status
	XMLOut = xmlhttp.responseText           	
	Set xmlhttp = Nothing
	XMLOut = REPLACE(REPLACE(REPLACE(XMLOut, "<?xml version=""1.0"" encoding=""Windows-1252""?>", ""),"<>",""),"</>","")
	'############################3

	If bDebug Then 
		MsgBox XMLOut ,,"boPost.CallTrn"
	End If 

	if err then
		boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, XMLOut
		If not Silent Then
			msgbox err.Number & " - " & err.Description, vBCritical, "Calling Business Object"
		End If
		exit function
	end if
	' Switch on error handling
	on error goto 0
	boLogBusinessObject BusinessObject, keyValue, XMLParam, XMLDoc, XMLOut	

	sBoXmlOut = XMLOut
	If InStr(XMLOut, "ErrorDescription") > 0 Then
		sBoError = boGetValues(XMLOut,"ErrorDescription", true)
		If not Silent Then
			MsgBox sBoError, 16, "Error Posting Business Object"
		End If
	End If

	boPostWcfActual = boGetValues(XMLOut, KeyNode, false)	

End Function

Function boLogBusinessObject(sType, sKey, sXMLParam, sXMLDoc, sXMLOut)
	dbPost("INSERT INTO [ipSys].[BOLog] ([Type], [Key], [XMLParam], [XMLDoc], [XMLOut], [Operator]) VALUES ('" & sType & "', '" & sKey & "', CAST('" & REPLACE(sXMLParam,"'","''") & "' AS XML), CAST('" & REPLACE(sXMLDoc,"'","''") & "' AS XML), CAST('" & REPLACE(sXMLOut,"'","''") & "' AS XML), '" & SystemVariables.CodeObject.Operator & "')")
End Function

Function boGetValues(sXmlOut, sNode, sShowNumber)
	If sXmlOut <> "" Then
		Dim xmlOut, objNodeList, values, i
		Set xmlOut = CreateObject("MSXML2.DOMDocument")
		xmlOut.async = False
		xmlOut.LoadXml (sXmlOut)
		
		values = ""
		If sNode <> "" Then
			Set objNodeList = xmlOut.getElementsByTagName(sNode)
			For i = 0 To (objNodeList.Length - 1)
				If sShowNumber Then
					values = values & CStr(i+1) & ") "
				End If
				values = values & objNodeList.Item(i).Text
				If i < (objNodeList.Length - 1) Then
					values = values & vbLF
				End If
			Next
			boGetValues = values
		End If

		Set xmlOut = Nothing 
		Set objNodeList = Nothing 
	End If
End Function