<% Function StoreEncrypt (SafeKey, StoreID, URLPostTo) StoreEncrypt = "StoreID=" & StoreID StoreEncrypt = URLPostTo &"?"& StoreEncrypt & "&StoreDigest=" & md5(LCase(SafeKey & StoreID)) End Function Response.Buffer = true Dim x, storeinfo, storename, StoreLogo, SQLLogin, SQLPassword, StoreID, DefaultConnectionsString, strSqlCat, init_catID, strSql_Categories, strCat, strSql_Products, isSearch, Image, cnnSafeshopStoreDB, ScriptName ScriptName = Request.ServerVariables("SCRIPT_NAME") StoreID = Application("StoreID") storename = Application("StoreName") StoreLogo = Application("storelogo") Application("StoreRef") = StoreID 'Set cnnSafeshopStoreDB = Server.CreateObject("adodb.connection") 'cnnSafeshopStoreDB.Open Application("connect2") Session("storename") = "WELCOME TO " & ucase(Application("StoreName")) storeinfo = Request("storeinfo") If Request("SafeTrack") <> "" Then Session("SafeTrack") = Request("SafeTrack") End If %> <%= Session("storename") %> " vlink="<%=application("linkcol")%>" alink="<%=application("linkcol")%>">
">" border="0" alt="<%= Application("storename")%>">
" onMouseover="on('trolley','images/trolley-on.gif')" onMouseout="off('trolley','images/trolley-off.gif')">Click to see items added to your trolley
Click to get help for this website
"> "> ">
"> " valign="middle" align="left">Click for Welcome page; font-family: arial; font-weight: bold ; background-color:<%=Application("dgray")%>">Welcome ">
"> " valign="middle">; font-family: arial; font-weight: bold">     Product Search ">
"> " valign="middle" align="center">
              		">
"> "> ">

<% '##------------------------------------------------------------------------------------------ '## 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") '## 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 %> <%End If%> <% End If Next End If End If Set root = Nothing Set xmldoc = Nothing %>
"> " valign="middle">  ; font-family: arial; font-weight: bold">Browse Categories ">
"> " valign="middle" onMouseover="changeto('<%=Application("lgray")%>')" onMouseout="changeback('<%=Application("dgray")%>')"> <%If SubCat = True Then%> <%Else%> <% 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 %>
; font-family: arial; font-weight: bold"> <%=root.childNodes.Item(iCntSub).childNodes.Item(1).Text%>
<% '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 %> 		">
"> ">
"> ">
"> " valign="middle">  ">
"> "> ">
">   ; font-family: arial; font-weight: bold;"> <% Dim rsHeading, CategoryID CategoryID = Request("CategoryID") If CategoryID = "" Then CategoryID = init_catID If Request("CategoryID") > 0 Then strSql_Categories = "select * from Category where CategoryID=" & CategoryID Set rsHeading = cnnSafeshopStoreDB.Execute(strSql_Categories) strCat = rsHeading("CategoryDescription") rsHeading.Close Set rsHeading = Nothing Else strCat = Session("storename") End If %> <%If storeinfo = "" And Request("strSearch") = "" Then Response.Write (Request("CategoryDescription")) Else Select Case LCase(storeinfo) Case "shipping" storeinfo = "Shipping Info" Case "help" storeinfo = "Help" Case "security" storeinfo = "Your Security" Case "contactus" storeinfo = "Contact Us" Case "aboutus" storeinfo = "About Us" Case "returnpolicy" storeinfo = "FAQ's" Case "privacystatement" storeinfo = "Privacy Statement & Legal Stuff" Case "welcome" storeinfo = Session("storename") End Select Response.Write (storeinfo) End If If Request("strSearch") <> "" Then Response.Write "Search Results for """ & Request("strSearch") & """" Else Response.Write (" ") End If %>
<% If Request("CategoryID") <> "" Or Request.Form.Count > 0 OR Request("ProductID") <> "" Then If Request("CategoryID") <> "" Then strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " " & _ " " & _ " Category" & _ " SKUNumber, ProductName, ProductShortDescription, ProductLongDescription, ProductLongDescriptionLength, RetailPriceInCents, CategoryName, ProductImage_Standard, ProductImage_Thumbnail, ExtraParameter1, ExtraParameter2, SpecialPriceInCents, SpecialStartDate, SpecialStartEnd" & _ " "& Request("CategoryID") &"" & _ " SKUNumber" & _ " " & _ "" XMLNode = "CategoryProducts" ElseIf Request("ProductID") <> "" Then strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " single" & _ " SKUNumber, ProductName, ProductShortDescription, ProductLongDescription, ProductLongDescriptionLength, RetailPriceInCents, CategoryName, ProductImage_Standard, ProductImage_Thumbnail, ExtraParameter1, ExtraParameter2, SpecialPriceInCents, SpecialStartDate, SpecialStartEnd" & _ " " & _ " " & Request("ProductID") & "" & _ " " & _ " " & _ "" XMLNode = "Product" Else strSearch = Request("strSearch") strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " Search" & _ " SKUNumber, ProductName, ProductShortDescription, ProductLongDescription, ProductLongDescriptionLength, RetailPriceInCents, CategoryName, ProductImage_Standard, ProductImage_Thumbnail, ExtraParameter1, ExtraParameter2, SpecialPriceInCents, SpecialStartDate, SpecialStartEnd" & _ " " & _ " "& strSearch &"" & _ " "& strSearch &"" & _ " "& strSearch &"" & _ " " & _ " SKUNumber" & _ " " & _ "" isSearch = True XMLNode = "Product" End If Set xmldocProduct = Server.CreateObject("Msxml2.DOMDocument.4.0") '## Create XML Object Loaded = xmldocProduct.loadXML(GetXMLHttp(Application("strPostXML"), strXMLSend)) '## Load requested Data 'Response.Write GetXMLHttp(Application("strPostXML"), strXMLSend) 'Response.End If Loaded Then '## Check for xml is loaded in DOM '## -------------------------------------------------------------------------------------------------- '## Check if an error returned If xmldocProduct.documentElement.selectNodes("//SafeShopError").length > 0 Then If InStr(xmldocProduct.documentElement.selectSingleNode("SafeShopError").Text, "}") <> "" Then Response.Write "Error" & xmldocProduct.documentElement.selectSingleNode("SafeShopError").Text End If Set xmldocProduct = Nothing End If Dim rootProducts Set rootProducts = xmldocProduct.documentElement If rootProducts.childNodes.length = 0 Then if request("show") <> "yes" then Response.Write "

No records were found.

" End If blnProduct = True If Request("sCatName") <> "" Then strCatName = Request("sCatName") Set objNodeList = xmldocProduct.documentElement.selectNodes(XMLNode) '## Get Total Transactions sent If objNodeList.length = 0 Then blnProduct = False if request("show") = "yes" then Response.Write "

Please click on sub category.

" end if End If Else Response.Write "Error " End If End If If blnProduct = True Then Set objNodeList = xmldocProduct.documentElement.selectNodes(XMLNode) '## Get Total Transactions sent If objNodeList.length = 0 Then ' Response.Write "

No records were found.

" Else For intNodeCnt = 0 To (objNodeList.length - 1) '## Loop in transaction PageCounterStart = ((Currentpage-1) * iRecordsPerPage) + 1 ' ## Start point of counter on this page Set currNode = xmldocProduct.documentElement.childNodes.Item(intNodeCnt) '## Current Next Node Set nextNode = currNode.nextSibling '## Next Node Sibling Set oNodeList = currNode.childNodes '## Next Child Nodes '## Reset Var ProductName = "" SKUNumber = "" ProductShortDescription = "" ProductLongDescription = "" ProductImage_Standard = "" ProductImage_Thumbnail = "" RetailPriceInCents = 0 ExtraParameter1 = "" ExtraParameter2 = "" SpecialPriceInCents = 0 SpecialStartDate = "" SpecialStartEnd = "" strMoreInfo = "" strDescription = "" strProductImage = "" For Each Item In oNodeList For Each ChildItem In Item.childNodes If LCase(Item.nodeName) = LCase("ProductName") Then ProductName = ChildItem.Text If LCase(Item.nodeName) = LCase("SKUNumber") Then SKUNumber = ChildItem.Text If LCase(Item.nodeName) = LCase("ProductShortDescription") Then ProductShortDescription = ChildItem.Text If LCase(Item.nodeName) = LCase("ProductLongDescription") Then ProductLongDescription = ChildItem.Text If LCase(Item.nodeName) = LCase("ProductLongDescriptionLength") Then ProductLongDescriptionLength = ChildItem.Text If LCase(Item.nodeName) = LCase("ProductImage_Standard") Then ProductImage_Standard = ChildItem.Text If LCase(Item.nodeName) = LCase("ProductImage_Thumbnail") Then ProductImage_Thumbnail = ChildItem.Text If LCase(Item.nodeName) = LCase("RetailPriceInCents") Then RetailPriceInCents = ChildItem.Text If LCase(Item.nodeName) = LCase("ExtraParameter1") Then ExtraParameter1 = ChildItem.Text If LCase(Item.nodeName) = LCase("ExtraParameter2") Then ExtraParameter2 = ChildItem.Text If LCase(Item.nodeName) = LCase("SpecialPriceInCents") Then SpecialPriceInCents = ChildItem.Text If LCase(Item.nodeName) = LCase("SpecialStartDate") Then SpecialStartDate = Replace(ChildItem.Text, "T", " ") If LCase(Item.nodeName) = LCase("SpecialStartEnd") Then SpecialStartEnd = Replace(ChildItem.Text, "T", " ") blnSpecial = False If SpecialPriceInCents >= 0 Then If SpecialStartDate = "" And SpecialStartEnd = "" Then '## Start and End Date blank blnSpecial = False ElseIf SpecialStartDate = "" Then '## Start date blank If SpecialStartEnd <> "" Then If DateDiff("d", SpecialStartEnd, now) <= 0 Then blnSpecial = True Else blnSpecial = True End If ElseIf SpecialStartEnd = "" Then '## End date blank If SpecialStartDate <> "" Then '## Start date not blank and check start date If DateDiff("d", SpecialStartDate, now) >= 0 Then blnSpecial = True Else blnSpecial = True End if ElseIf DateDiff("d", SpecialStartDate, now) >= 0 And DateDiff("d", SpecialStartEnd, Now) <= 0 Then blnSpecial = True End if End If Next Next If ProductImage_Thumbnail <> "" Then ProductImage = ProductImage_Thumbnail ElseIf ProductImage_Standard <> "" Then ProductImage = ProductImage_Standard Else ProductImage = "images/nopic.gif" End If DisableBuyButton = True If LCase(HideBuyButton) <> "true" Then DisableBuyButton = False End If If LCase(ShowCategoryLevelBuyButton) = "false" And Request("lev") = 1 Then DisableBuyButton = True End If 'Call DisplayProduct(Level1For, ProductName, SKUNumber, ProductShortDescription, ProductLongDescriptionLength, ProductImage, _ ' RetailPriceInCents, ExtraParameter1, ExtraParameter2, SpecialPriceInCents, SpecialStartDate, SpecialStartEnd, DisableBuyButton) %>
<% if ProductImage <> "images/nopic.gif" then %> <% else %> <% end if %>
<%= ProductName %>
; font-family: arial; font-weight: bold"><%= ProductName %>
<%If Len(ProductLongDescription) Then%>
<%= ProductLongDescription %>
<%Else%>
<%= ProductShortDescription %>
<%End If%>
; font-family: arial; font-weight: bold"><%= ProductName %>
<%If Len(ProductLongDescription) Then%>

<%= ProductLongDescription %>
<%Else%>

<%= ProductShortDescription %>
<%End If%>

<% If ExtraParameter2 <> "" Then splitExtraParameter2 = Split(ExtraParameter2, ",") Response.Write "
Please Select: " End if If ExtraParameter1 <> "" Then Response.Write "
Please Select: " For iSplit = 0 To UBound(splitExtraParameter1) Response.Write "" & Replace(splitExtraParameter1(iSplit), ",", "") Next End If %>
; font-family: arial; font-weight: bold"><% if RetailPriceInCents <> 0 then %>R <%=FormatNumber(RetailPriceInCents / 100, 2) %>        <% end if %>
    <%if Request("parentid") > 0 Or RetailPriceInCents <> 0 then%> Click to add this item to your trolley.There is no obligation to buy and you can remove it from your trolley at any time. <%end if%>
<% Next End if Set xmldocProduct = Nothing Set rootProducts = Nothing End if If Request("storeinfo") = "" And Request("CategoryID") = "" And Not isSearch And Request("ProductID") = "" Then '## -------------------------------------------------------------------------------------------------- '## Get the Store Site Landing Page '## -------------------------------------------------------------------------------------------------- strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " Homepage" & _ " " & _ "" Set xmldoc = Server.CreateObject("Msxml2.DOMDocument.4.0") '## Create XML Object Loaded = xmldoc.loadXML(GetXMLHttp(Application("strStoreSiteXML"), 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 If InStr(LCase(xmlDoc.documentElement.selectSingleNode("Error").Text), "maintenance mode") Then Response.Redirect("https://secure.safeshop.co.za/Maintenance.asp") Response.End End If Response.Redirect("https://secure.safeshop.co.za/Error.asp?Error="& xmlDoc.documentElement.selectSingleNode("Error").Text) Response.End End If End If If xmlDoc.documentElement.selectNodes("//StoreSiteHomepage/HompageText").length > 0 Then strHompageText = xmlDoc.documentElement.selectSingleNode("StoreSiteHomepage/HompageText").Text End If End If Set root = Nothing Set xmldoc = Nothing Else If LCase(storeinfo) = "help" Then strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " HelpPage" & _ " " & _ "" Set xmldoc = Server.CreateObject("Msxml2.DOMDocument.4.0") '## Create XML Object Loaded = xmldoc.loadXML(GetXMLHttp(Application("strStoreSiteXML"), 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 If xmlDoc.documentElement.selectNodes("//StoreSiteHelpPage/HelpPageText").length > 0 Then strHompageText = xmlDoc.documentElement.selectSingleNode("StoreSiteHelpPage/HelpPageText").Text End If End If Set root = Nothing Set xmldoc = Nothing Else If Request("storetext") = "yes" or request("storeinfo") = "welcome" then Set xmldocFix = Server.CreateObject("Msxml2.DOMDocument.4.0") '## Create XML Object If Request("CatID") <> "" Then strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " Category" & _ " "& Request("CatID") &"" & _ " " & _ " " & _ " " & _ " " & _ "" Loaded = xmldocFix.loadXML(GetXMLHttp(Application("strStoreSiteXML"), strXMLSend)) '## Load requested Data If Loaded Then '## Check for xml is loaded in DOM '## -------------------------------------------------------------------------------------------------- '## Check if an error returned If xmldocFix.documentElement.selectNodes("//SafeShopError").length > 0 Then If InStr(xmldocFix.documentElement.selectSingleNode("SafeShopError").Text, "}") <> "" Then Response.Write "Error" & xmldocFix.documentElement.selectSingleNode("SafeShopError").Text End If Set xmldocFix = Nothing End If Set rootProducts = xmldocFix.documentElement If rootProducts.childNodes.length = 0 Then 'strHompageText = "No Record Found" End If End If If xmldocFix.documentElement.selectNodes("//FixCategoryPageText").length > 0 Then strHompageText = xmldocFix.documentElement.selectSingleNode("//FixCategoryPageText").Text End If Set xmldocFix = Nothing End If End If End If End If If strHompageText <> "" Then Response.Write ("

") Response.Write strHompageText Response.Write ("
") End if %>
Powered & protected by M-Web Safeshop

(Japanese Help)
<% Dim xmldocFix '## -------------------------------------------------------------------------------------------------- '## Get the Categories '## -------------------------------------------------------------------------------------------------- strXMLSend = "" & _ "" & _ " " & _ " "& Application("SafeKey") &"" & _ " " & _ " " & _ " all" & _ " " & _ " " & _ " " & _ "" %> <% Set xmldocFix = Server.CreateObject("Msxml2.DOMDocument.4.0") '## Create XML Object Loaded = xmldocFix.loadXML(GetXMLHttp(Application("strStoreSiteXML"), strXMLSend)) '## Load requested Data If Loaded Then '## Check for xml is loaded in DOM If xmldocFix.documentElement.selectNodes("//Error").length > 0 Then If InStr(xmldocFix.documentElement.selectSingleNode("Error").Text, "}") <> "" Then Response.Write "Error" & xmldocFix.documentElement.selectSingleNode("Error").Text End If End If Set root = xmldocFix.documentElement If root.childNodes.length = 0 Or xmldocFix.documentElement.selectNodes("//StoreSiteFixCategoryID").length = 0 Then 'Response.Write "No Record Found" Else For iCnt = 0 To (root.childNodes.length - 1) %> <% Next End If Else 'Response.Write "Error " End If Set root = Nothing Set xmldocFix = Nothing %>
"> ; font-family: arial; font-weight: bold; background-color: <%=application("dgray")%>">   <% = UCase(root.childNodes.Item(iCnt).childNodes.Item(1).Text) %>
"> <% = root.childNodes.Item(iCnt).childNodes.Item(2).Text %>
VISA and MasterCard accepted