ASP通过XMLHTTP取数据，还有个ASP操作XML文件

以前写过的一个ASP通过XMLHTTP取数据的东西，留着说不定以后还要用。

<%
const XRPC_RESOLVE_TIMEOUT = 10000 '5000
const XRPC_CONNECT_TIMEOUT = 10000 '500
const XRPC_SEND_TIMEOUT = 15000 '1000
const XRPC_RECEIVE_TIMEOUT = 20000 '10000
const techdataUrl = "https://tdxml.techdata.com/xmlservlet"
const UserName = "500376"
const Password = "97QAMVL"
const TransSetIDCode = "846SEND"
const TransControlID = "10000"
const ResponseVersion = "1.4"
dim LangQtyLowError,techdataErrorInfo
LangQtyLowError = "The product may not be in stock. you can not buy it."

function xmlRPC(productIds)
	Dim requestText,objXML,objLst,returnQtys
	requestText = CreateRequestXML(productIds)	

	'' Now use the redistributable parser objects alone
	Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")

	objXML.setTimeouts XRPC_RESOLVE_TIMEOUT, XRPC_CONNECT_TIMEOUT, XRPC_SEND_TIMEOUT, XRPC_RECEIVE_TIMEOUT 

	''Call the remote machine the request
	On Error Resume Next
	objXML.open "POST", techdataUrl, false
	objXML.setRequestHeader "Content-Type", "text/xml"
	objXML.send(requestText)

	If not objXML.status = 200 Then 
		shoperror "The service is not available, please check hours."
	end if

	if objXML.responseText = "Request received outside of server business hours" Then 
		shoperror "The service is not available, please check hours."
	end if

	serverResponseText = objXML.responseText

	''response.Write serverResponseText

	Set LineInfoList=objXML.responseXML.getElementsByTagName("LineInfo")
	for j = 0 To LineInfoList.length-1

		Set ErrorInfoList=LineInfoList.Item(j).getElementsByTagName("ErrorInfo")
		if ErrorInfoList.length > 0 Then	
			Set errorList=ErrorInfoList.Item(0).getElementsByTagName("ErrorDesc")
			techdataErrorInfo = errorList.Item(0).text
			shoperror techdataErrorInfo
		end if

		Set WhseInfoList=LineInfoList.Item(j).getElementsByTagName("WhseInfo")
		Dim Qtys
		Qtys = 0
		for i = 0 To WhseInfoList.length-1
			Set QtyList=WhseInfoList.Item(i).getElementsByTagName("Qty")
			Qtys = Qtys + QtyList.Item(0).Text			
		next
		IF j = LineInfoList.length-1 Then
			returnQtys = returnQtys & Qtys
		else
			returnQtys = returnQtys & Qtys & ","
		End If
	next
	xmlRPC = returnQtys

	Set LineInfoList = Nothing
	Set objXML = Nothing	
end function	

function CreateRequestXML(productIds)
	Set objXMLdoc = CreateObject("Microsoft.XMLDOM")

	Set rootNode = objXMLdoc.createElement("XML_Availability_Submit")
	objXMLdoc.appendChild(rootNode)

	Set HeaderNode = objXMLdoc.createElement("Header")
	rootNode.appendChild(HeaderNode)

	Set UserNameNode = objXMLdoc.createElement("UserName")
	UserNameNode.Text = UserName
	HeaderNode.appendChild(UserNameNode)

	Set PasswordNode = objXMLdoc.createElement("Password")
	PasswordNode.Text = Password
	HeaderNode.appendChild(PasswordNode)

	Set TransSetIDCodeNode = objXMLdoc.createElement("TransSetIDCode")
	TransSetIDCodeNode.Text = TransSetIDCode
	HeaderNode.appendChild(TransSetIDCodeNode)

	Set TransControlIDNode = objXMLdoc.createElement("TransControlID")
	TransControlIDNode.Text = TransControlID
	HeaderNode.appendChild(TransControlIDNode)

	Set ResponseVersionNode = objXMLdoc.createElement("ResponseVersion")
	ResponseVersionNode.Text = ResponseVersion
	HeaderNode.appendChild(ResponseVersionNode)	

	Set DetailNode = objXMLdoc.createElement("Detail")
	rootNode.appendChild(DetailNode)

	Dim mystr
	mystr=split(productIds,",")

	for i=0 to ubound(mystr) 
		If len(mystr(i)) <> 0 then			
			Set LineInfoNode = objXMLdoc.createElement("LineInfo")
			DetailNode.appendChild(LineInfoNode)

			Set AssignedIDNode = objXMLdoc.createElement("AssignedID")
			AssignedIDNode.Text = i
			LineInfoNode.appendChild(AssignedIDNode)

			Set RefIDQualNode = objXMLdoc.createElement("RefIDQual")
			RefIDQualNode.Text = "VP"
			LineInfoNode.appendChild(RefIDQualNode)

			Set RefIDNode = objXMLdoc.createElement("RefID")
			RefIDNode.Text = mystr(i)
			LineInfoNode.appendChild(RefIDNode)
		End if

	next

	Set SummaryNode = objXMLdoc.createElement("Summary")
	rootNode.appendChild(SummaryNode)

	Set NbrOfSegmentsode = objXMLdoc.createElement("NbrOfSegments")
	SummaryNode.appendChild(NbrOfSegmentsode)

	CreateRequestXML = rootNode.xml
	''response.Write CreateRequestXML
	Set objXMLdoc = Nothing
end function

Sub checkQtyError (quantity, ccode)
	Qty = xmlRPC(ccode)
	If CInt(Qty) < 1 Then 
		shoperror LangQtyLowError
	End if
	If CInt(Qty) < CInt(quantity) Then
		If CInt(Qty) < 2 Then 		
			shoperror "There are "& Qty&" product in the stock, you can only buy "&Qty&"." 
		Else
			shoperror "There are "& Qty&" products in the stock, you can only buy "&Qty&"." 
		End If
	End if
end sub

Sub ShopError (msg)
setsess "shoperror", msg
responseredirect "shoperror.asp"
end sub
%>