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
%>