<%
'##------------------------------------------------------------------------------------------
'## Get a info across Http using XML object
'##------------------------------------------------------------------------------------------
Function GetXMLHttp(ByVal HTTPLocation, Byval XMLData)
Dim strErrorMsg
Dim xmlhttp
Dim strRemoteDataResult
'## URLString is the URL that is to be requested
'## FormInputArray are the names of the tags
'## FormValueArray are the actual values of the corresponding tags
'## Erorr checkking
If InStr(HTTPLocation, "/") = 0 Then
GetXMLHttp = "Error: Remote Address not supplied "
Exit Function
End If
'## Set XML HTTP Object
Set objXMLHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP.4.0") '## Initializes an MSXML2.ServerXMLHTTP
objXMLHTTP.Open "POST", HTTPLocation, False '## Initializes XMLHTTP request, and specifies the method, URL, and authentication information for the request.
objXMLHTTP.send XMLData '## Sends an HTTP request to the server and receives a response
strRemoteDataResult = Trim(objXMLHTTP.responseText) '## Get response text and set to var
If InStr(LCase(strRemoteDataResult), LCase("-2146697211")) Then '## Web Server is Down
strErrorMsg = "Error: Web Server not responding."
ElseIf InStr(LCase(strRemoteDataResult), LCase("HTTP 404")) Then '## The page cannot be found
strErrorMsg = "Error: The page cannot be found."
ElseIf InStr(LCase(strRemoteDataResult), LCase("80004005")) Then '## Server.CreateObject Failed
strErrorMsg = "Error: " & strRemoteDataResult
ElseIf InStr(LCase(strRemoteDataResult), LCase("Error:")) Then '## Error on web server
strErrorMsg = "Error: " & strRemoteDataResult
ElseIf LCase(strRemoteDataResult) = LCase("NoRecord") Then
strErrorMsg = "Error: No New Record"
ElseIf strRemoteDataResult = "" Then
strErrorMsg = "Error: No New Record"
End If
If strErrorMsg <> "" Then
GetXMLHttp = strErrorMsg
Else
GetXMLHttp = strRemoteDataResult
End If
Set objXMLHTTP = Nothing
End Function
Sub d(strString)
Response.Write "##"& strString &"##"
Response.End
End Sub
'## --------------------------------------------------------------------------------------------------
'##
'## --------------------------------------------------------------------------------------------------
Dim xmlDoc
iLevels = Request("Lev")
iRootID = Request("parentid")
iCategoryID = Request("CategoryID")
iLevCatID = Request("LevCatID")
'## --------------------------------------------------------------------------------------------------
'## Get the Categories
'## --------------------------------------------------------------------------------------------------
Dim strXMLSend
strXMLSend = "" & _
"" & _
" " & _
" "& Application("SafeKey") &"" & _
" " & _
" " & _
" all" & _
" " & _
" " & _
" " & _
""
'd GetXMLHttp(Application("strPostXML"), strXMLSend)
Set xmldoc = Server.CreateObject("Msxml2.DOMDocument.4.0") '## Create XML Object
Loaded = xmldoc.loadXML(GetXMLHttp(Application("strPostXML"), strXMLSend)) '## Load requested Data
If Loaded Then '## Check for xml is loaded in DOM
'## --------------------------------------------------------------------------------------------------
'## Check if an error returned
If xmlDoc.documentElement.selectNodes("//Error").length > 0 Then
If InStr(xmlDoc.documentElement.selectSingleNode("Error").Text, "}") <> "" Then
Response.Write "Error" & xmlDoc.documentElement.selectSingleNode("Error").Text
End If
End If
Dim root, iCnt
Set root = xmlDoc.documentElement
If root.childNodes.length > 0 And xmlDoc.documentElement.selectNodes("//CategoryID").length > 0 Then
On error resume next
For iCnt = 0 To (root.childNodes.length - 1)
SubCat = False
CatID = root.childNodes.Item(iCnt).childNodes.Item(0).Text
BelongCatID = root.childNodes.Item(iCnt).childNodes.Item(3).Text
If BelongCatID = 0 Then
'## Find out if this level has a sub Categories
For iCntSub = 0 To (root.childNodes.length - 1)
SubBelongCatID = root.childNodes.Item(iCntSub).childNodes.Item(3).Text
If CStr(CatID) = CStr(SubBelongCatID) Then
SubCat = True
For iCntSubSub = 0 To (root.childNodes.length - 1)
SubSubBelongCatID = root.childNodes.Item(iCntSubSub).childNodes.Item(3).Text
If CStr(SubCatID) = CStr(SubSubBelongCatID) Then
SubCat = True
End If
Next
End If
Next
'Call PrintProductCat (CatID, root.childNodes.Item(iCnt).childNodes.Item(1).Text, SubCat, 1, CatID)
'## Level 1
%>
">
" valign="middle" onMouseover="changeto('<%=Application("lgray")%>')" onMouseout="changeback('<%=Application("dgray")%>')">
<% if SubCat = True then ' this means there are sub cats%>
<% end if %>
<%
For iCntSub = 0 To (root.childNodes.length - 1)
SubCatID = root.childNodes.Item(iCntSub).childNodes.Item(0).Text
SubBelongCatID = root.childNodes.Item(iCntSub).childNodes.Item(3).Text
If CStr(CatID) = CStr(SubBelongCatID) Then
'## Level 2
If (iCategoryID = CatID OR iRootID = CatID) Then
%>
<%
'Call PrintProductCat (SubCatID, root.childNodes.Item(iCntSub).childNodes.Item(1).Text, SubCat, 2, CatID)
End If
For iCntSubSub = 0 To (root.childNodes.length - 1)
SubSubCatID = root.childNodes.Item(iCntSubSub).childNodes.Item(0).Text
SubSubBelongCatID = root.childNodes.Item(iCntSubSub).childNodes.Item(3).Text
If CStr(SubCatID) = CStr(SubSubBelongCatID) Then
'## Level 3
If (iCategoryID = SubCatID And iLevels = 2) Or (iRootID = CatID And iLevels = 3) Then
Call PrintProductCat (SubSubCatID, root.childNodes.Item(iCntSubSub).childNodes.Item(1).Text, False, 3, CatID)
End If
End If
Next
End If
Next
If (iCategoryID <> CatID OR iRootID <> CatID) Then
%>
">
<%
end if
End If
Next
End If
End If
Set root = Nothing
Set xmldoc = Nothing
%>
<%= root.childNodes.Item(iCnt).childNodes.Item(1).Text %> ::