<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> Bench Equipment - Tyco Electronics <% '############################################################ 'This function returns the correct version of TE_templateHead.inc instead of writing out the #includes directive. 'Just pass it the relative path 'Example: ' Response.Write(GetTemplateHead(server.mappath("/_TEincludes/TE_template_head.inc"))) '############################################################ function GetTemplateHead(path) dim f, temp, debug, dojojs dim fso : set fso = CreateObject("Scripting.FileSystemObject") set f = fso.OpenTextFile(path, 1, false) temp = f.ReadAll() if TurnOnDebugMode then if instr(temp, "djConfig = {") > 0 then debug = "djConfig = {" & vbcrlf & "isDebug: true," & vbcrlf dojojs = "" temp = replace(temp, "", dojojs) temp = replace(temp,"djConfig = {",debug) end if end if GetTemplateHead = temp f.Close() set fso = nothing set f = nothing end function '############################################################ 'This function returns the correct version of TE_bodyTop.inc instead of writing out the #includes directive. 'Just pass it the relative path 'Example: ' Response.Write(GetBodyTop(server.mappath("/_TEincludes/TE_bodyTop.inc"))) '############################################################ function GetBodyTop(path) dim f dim fso : set fso = CreateObject("Scripting.FileSystemObject") set f = fso.OpenTextFile(path, 1, false) GetBodyTop = f.ReadAll() f.Close() set fso = nothing set f = nothing end function function TurnOnDebugMode() dim val : val = request.querystring("djdebug") if instr(Application("TE_LPHOME_INTERNET"), "dev") > 0 then if val = "y" then 'Change TE_templateHead.inc's djConfig to use isDebug: true TurnOnDebugMode = true else TurnOnDebugMode = false end if else TurnOnDebugMode = false end if end function '########################################################### ' The TE_LinkPath function returns a quoted string of a link to an ' application on another server. This function should be used to allow ' the servers to be configurable and easily changed between development, ' QA, and production. The actual server paths are set in the ' Application object in the Global.asa file at the root of the web ' server. To use the function, call it with a server identifier and the ' relative path on that server. ' ' For example: ' TE_LinkPath "TE_LPECATALOG", "/local/path/app.html" ' '########################################################### sub TE_LinkPath(serverID, relativeURL) response.write("""" & Application(serverID) & relativeURL & """") end sub sub TE_Server(serverID) response.write Application(Ucase(trim(serverID))) end sub '########################################################### ' The TE_breadCrumb function creates the arrays needed to form the breadcrumb based on ' the URL of the web page and calls the TE_displayBreadCrumb(urlArray,textArray) function ' to display the breadCrumb on the page. The ExtraRemoveString parameter passed in can ' contain extra files and folders (other than the defaults) to strip from the breadcrumb. '########################################################### sub TE_breadCrumb() TE_breadCrumbFunction "","" end sub sub TE_breadCrumbWithRemoveString(ExtraRemoveString) TE_breadCrumbFunction ExtraRemoveString,"" end sub sub TE_breadCrumbWithRemoveStringAndPageTitle(ExtraRemoveString,PageTitle) if len(trim(PageTitle))<> 0 then TE_breadCrumbFunction ExtraRemoveString&"|(/"&mid(request.ServerVariables("SCRIPT_NAME"),instrRev(request.ServerVariables("SCRIPT_NAME"),"/")+1)&"$)",PageTitle else TE_breadCrumbWithRemoveString(ExtraRemoveString) end if end sub sub TE_breadCrumbWithPageTitle(PageTitle) TE_breadCrumbFunction "|(/"&mid(request.ServerVariables("SCRIPT_NAME"),instrRev(request.ServerVariables("SCRIPT_NAME"),"/")+1)&"$)",PageTitle end sub sub TE_breadCrumbFunction(ExtraRemoveString,PageTitle) dim href : href = request.ServerVariables("PATH_INFO") 'This removeString variable contains the list pages and folders that will be stripped from the breadcrumb dim removeString : removeString ="(/default.asp$)|(/default.htm$)|(/default.html$)|(/index.asp$) | (/index.htm$)|(/index.html$)|(/_teincludes/)|(/_teerror/)" & lcase(ExtraRemoveString) dim removeRegExp : set removeRegExp = new RegExp removeRegExp.Global = true removeRegExp.IgnoreCase = true removeRegExp.pattern = removeString dim fullPath : fullPath = href ' save full path do while removeRegExp.test(href) href = removeRegExp.Replace(href,"/") ' remove file names not to be shown loop dim path: path = href 'Create an array of the names of the folders and filename if PageTitle <> "" then path = path + PageTitle dim textArray : textArray = split(path,"/") dim urlArray : urlArray = textArray dim i for i = 1 to uBound(textArray) ' remake the url for each text link urlArray(i) = left(fullPath,instr(fullPath,textArray(i))+len(textArray(i))) next textArray(0) = "Home" ' add the home text and link urlArray(0) = "/" ' call TE_displayBreadCrumb passing the arrays made here TE_displayBreadCrumb urlArray,textArray end sub '########################################################### ' The TE_displayBreadCrumb function takes in an array of URLs and the text to display and ' creates a breadcrumb from them. Calls the TE_cleanText function to clean the text before ' it is displayed. ' if Possably don't not call this directly '########################################################### function TE_displayOneBreadCrumb(url,text) if (url <> "") then TE_displayOneBreadCrumb = "" & TE_cleanText(text) & "" else TE_displayOneBreadCrumb = "" & TE_cleanText(text) & "" end if end function function makeIntoArry(PotentialArray) if IsArray(PotentialArray) then makeIntoArry = PotentialArray else if instr(PotentialArray,",")>0 then makeIntoArry = split(PotentialArray,",") elseif instr(PotentialArray,"|")>0 then makeIntoArry = split(PotentialArray,"|") elseif instr(PotentialArray,";")>0 then makeIntoArry = split(PotentialArray,";") elseif instr(PotentialArray,":")>0 then makeIntoArry = split(PotentialArray,":") elseif instr(PotentialArray,"#")>0 then makeIntoArry = split(PotentialArray,"#") else makeIntoArry = split(PotentialArray," ") end if End if end function sub TE_displayBreadCrumb(urlArray,textArray) dim CrumbSeparator: CrumbSeparator = " > " ' change this to change the Seperater urlArray = makeIntoArry(urlArray) textArray = makeIntoArry(textArray) if (instr(urlArray(Ubound(urlArray)),"iframe.asp") < 1 ) then' not iframe page dim i,path for i = 0 to uBound(textArray) ' no separator for fist and missing text if (i > 0) and not(instr(right(trim(path),5),">") > 0)then path = path & CrumbSeparator end if ' test see if the next link is blank and therefor this is the last link show and exit for loop if (Ubound(textArray) > i) then ' protect i+1 test if (len(textArray(i+1))=0)then ' the next link empty path = path & TE_displayOneBreadCrumb("", textArray(i)) exit for end if end if if (Ubound(textArray) = i) then path = path & TE_displayOneBreadCrumb("", textArray(i)) elseif (Ubound(urlArray)=> i) then path = path & TE_displayOneBreadCrumb(urlArray(i), textArray(i)) end if next else 'iframe page Give user option to breack out of the frame mostly used "n in one" code path = path &"Off-Site Link:"& TE_cleanText(textArray(Ubound(textArray)))& " (Click to open in a new window)" end if ' not iframe page ' if len(path) > 17 then' HomePage do not show ' write to the web page response.write("
"&path& "
") ' wraped in outer div and add closing span ' end if ' HomePage do not show end sub '########################################################### ' The TE_cleanText tidies up the link text by removing the extension, swapping %20 and _ ' for spaces, adds spaces into camel-cased words and capitalizes the first letter of each ' word. '########################################################### function TE_cleanText(LinkText) dim removeRegExp : set removeRegExp = new RegExp ' create reg exp removeRegExp.Global = true removeRegExp.IgnoreCase = true dim previousText 'Remove the file extention removeRegExp.pattern = "(^$_)|(.asp$)|(.html$)|(.htm$) | (.woa$)|(.dll$)" LinkText = removeRegExp.Replace(LinkText,"") 'Replace %20 and _ with spaces previousText = LinkText removeRegExp.pattern = "(%20)|(_)" LinkText = removeRegExp.Replace(LinkText," ") 'only update camel-cased words if the other method was not used if LinkText = previousText then 'Add a space into camel-cased words removeRegExp.IgnoreCase = false removeRegExp.pattern = "([a-z])([A-Z])" LinkText = removeRegExp.Replace(LinkText,"$1 $2") end if 'capitalize the first letter LinkText = Ucase(left(LinkText,1)) & mid(LinkText,2) TE_cleanText = LinkText end function '########################################################### ' ' Check to see if a number is in an array ' '########################################################### function TE_NumberInArry(byval item,arrayToLookin) if isobject(item) then TE_NumberInArry = false exit function end if dim arrEle for each arrEle in arrayToLookin if StrComp(arrEle, item, 1) = 0 then TE_NumberInArry = true Exit Function end if next TE_NumberInArry = false end function %> <% '########################################################### ' ' ASP Functions to support the XML version of configurable ' menu ' '########################################################### '########################################################### ' ' TE_MenuGetLanguageElement ' Return the correct Element for language choice ' Parameters ' xmlDoc - the XMLDOM parser object ' languageId - the language to show the menu in ' [if a given language is not found, english ' will be returned by default] '########################################################### Function TE_MenuGetLanguageElement(ByRef xmlDoc,languageId) '* Dim i,lang,englishLang Dim node Dim isDone i=0 isDone = False ' Get the list of LANGUAGE element nodes from the XMLDOM document Dim resultElement Set resultElement = xmlDoc.selectSingleNode("/MENUCONFIG/LANGUAGE[@ID="&languageId&"]") If resultElement Is Nothing Then Response.Write("") Set resultElement = xmlDoc.selectSingleNode("/MENUCONFIG/LANGUAGE[@ID=1]") End If If resultElement Is Nothing Then Response.Write("") Set resultElement = xmlDoc.selectSingleNode("/MENUCONFIG/LANGUAGE") End If Set TE_MenuGetLanguageElement = resultElement End Function '########################################################### ' ' ASP Functions to support the determing a users application ' permissions. ' '########################################################### '########################################################### ' ' TE_MenuGetArrayFromIdString ' Convert the string list of appcodes into an array of appcodes ' '########################################################### Function TE_MenuGetArrayFromIdString(appcodeString) '* dim listRegExp : set listRegExp = new RegExp ' create reg exp listRegExp.Global = true listRegExp.IgnoreCase = true 'Find application codes separated by semicolons listRegExp.pattern = "([A-Z][A-Z0-9][A-Z0-9][A-Z0-9]?[A-Z0-9]?);?" Dim Matches, Match Set Matches = listRegExp.Execute(appcodeString) Dim retCodeArray() ReDim retCodeArray(Matches.Count) 'Response.Write("" & vbCrLf) Dim i For i=0 To Matches.Count -1 ' Iterate Matches collection. retCodeArray(i) = Matches.Item(i).subMatches(0) 'Response.Write("" & vbCrLf) Next TE_MenuGetArrayFromIdString = retCodeArray End Function '########################################################### ' ' TE_MenuIsUserAuthorized ' Compare a user's available application ids to the ids ' required by a particular menu item ' return True if the user has one of the ids required ' '########################################################### Function TE_MenuIsUserAuthorized(Available, Required) '* Dim retValue retValue = False ' Empty required list - then user is authorized... If required = "" Then retValue = True Else ' We have at least one required id Dim availableArray Dim requiredArray ' Convert Id's from a string of the user's SiteMinder available ids to an array availableArray = TE_MenuGetArrayFromIdString(Available) ' Convert Id's from a string of menu item's required Id's to an array requiredArray = TE_MenuGetArrayFromIdString(Required) 'Response.Write("" & vbCrLf) Dim r, a r = 0 ' Check each required id against the user's available ids ' Check until we find a successful case Do While retValue = False And r < UBound(requiredArray) ' Outer loop goes through the required list ' Inner loop checks the user's available ids ' Check until we find a successful case a = 0 Do While retValue = False And a < UBound(availableArray) ' If user has an ID that matches - great we are done If requiredArray(r) = availableArray(a) Then retValue = True 'Response.Write("" & vbCrLf) Else 'Response.Write("" & vbCrLf) End If a = a + 1 Loop r = r + 1 Loop End if 'Response.Write("" & vbCrLf) ' return whether the user is authorized... TE_MenuIsUserAuthorized = retValue End Function ' ' ' Function that looks for list of alpha codes and converts them to numeric codes. Function TE_GetAppCodeList(Appcodes) '* get http header variable, attribute name dim listRegExp : set listRegExp = new RegExp ' create reg exp listRegExp.Global = true listRegExp.IgnoreCase = true 'Find tokens separated by commas listRegExp.pattern = "([A-Z][A-Z0-9][A-Z0-9][A-Z0-9]?);?" Dim Matches, Match Set Matches = listRegExp.Execute(AppCodes) Dim AppList If Matches.Count >= 1 Then AppList = "" ' Got matches, convert them and return... Dim i For i=1 To Matches.Count ' Iterate Matches collection. Dim tempCode tempCode = "" tempCode = TE_ConvertAppCode(Matches.Item(i-1).subMatches(0)) 'Response.Write "

Matched Item: " & i & "= " & tempCode &"

" If tempCode > -1 Then If AppList <> "" Then AppList = AppList & "," End If AppList = AppList & tempCode End if Next 'Response.Write "

AppList: " & AppList &"

" Else AppList = Appcodes ' Do not covert if they don't match... End If TE_GetAppCodeList = AppList End Function ' Take the AppCode as alphanumeric string ' return the numeric code for that appcode Function TE_ConvertAppCode(AppCode) '* dim arrayOfCodes(36) arrayofCodes(1) = "CDA" arrayofCodes(2) = "OIN" arrayofCodes(3) = "OIN4" arrayofCodes(4) = "CXG" arrayofCodes(5) = "CXR" arrayofCodes(6) = "CXUS" arrayofCodes(7) = "MPI" arrayofCodes(8) = "PAV" arrayofCodes(9) = "PIN" arrayofCodes(10) = "USPAV" arrayofCodes(11) = "USPIN" arrayofCodes(12) = "SPI" arrayofCodes(13) = "SPU" arrayofCodes(14) = "GSPR" arrayofCodes(15) = "ATP" arrayofCodes(16) = "DIN" arrayofCodes(17) = "SRE" arrayofCodes(18) = "LRE" arrayofCodes(19) = "SCA" arrayofCodes(20) = "FOE" arrayofCodes(21) = "ISD" arrayofCodes(22) = "TRM" arrayofCodes(23) = "IFS" arrayofCodes(24) = "PCNC" arrayofCodes(25) = "TBAY1" arrayofCodes(26) = "TBAY2" arrayofCodes(27) = "TBAY3" arrayofCodes(28) = "TBAY4" arrayofCodes(29) = "NCA" arrayofCodes(30) = "NCI" arrayofCodes(31) = "PRU" arrayofCodes(32) = "PAU" arrayofCodes(33) = "BPD" arrayofCodes(34) = "IDL" arrayofCodes(35) = "DLM" arrayofCodes(36) = "OSP" Dim i Dim retCode retCode = -1 i=1 Do While retCode = -1 And i < UBound(arrayofCodes) If arrayofCodes(i) = AppCode Then retCode = i End If i = i + 1 Loop TE_ConvertAppCode = retCode End Function '########################################################### ' ' ASP Functions to support the file based version of language sensitive ' menu ' '########################################################### '########################################################### ' ' TE_GetMenuFile ' ' Read the Cookies written by the secure/commerce.asp ' and then use those as parameters to get a language and log ' on state specific menu ' ' Important: Return value is a UTF-8 Variant [if the file is a UTF-8 file] ' And to render properly that variant must be writen as a Response.BinaryWrite '########################################################### ' ' GetMenu - get the menu from the XML file Function TE_GetMenuFile() Dim username, unittype, appcodes,smCookie,langId username = Request.Cookies("TECewt2") appcodes = Request.Cookies("TECewt1") smCookie = Request.Cookies("SMSESSION") langId = Request.Cookies("language_id") Dim logOnStatus logOnStatus = "off" If Len(smCookie) > 0 And smCookie <> "LOGGEDOFF" Then logOnStatus = "on" End If If Len(langId) = 0 Then langId = "1" End if Dim menuHtml menuHtml = " Menu not generated - problem with website configureation" Dim fileName fileName = "TE_menu_" & langId & "_" & logOnStatus & ".inc" Dim menuFileDir menuFileDir = "/_TEincludes/TEmenu/" 'If Len(menuFileDir) = 0 Then 'menuFileDir = "/_TEincludes/TEmenu/" 'End If Dim foundFile foundfile = False Dim fs Set fs=Server.CreateObject("Scripting.FileSystemObject") fileName = Server.MapPath(menuFileDir & fileName) If (fs.FileExists(fileName))=false Then fileName = Server.MapPath(menuFileDir & "TE_menu_" & "1" & "_" & logOnStatus & ".inc") End If If (fs.FileExists(fileName))=true Then Dim file, ts Set file = fs.GetFile(fileName) Const ForReading = 1 Const TristateTrue = -1, TristateDefault = -2 Set ts = file.OpenAsTextStream(ForReading,TristateTrue) menuHtml = ts.ReadAll ts.Close Set ts = Nothing Set file = Nothing End If Set fs = Nothing ' Remember this value is not a typical string - but an UTF-8 string ' so must use Response.BinaryWrite instead of Response.Write to get it ' to display properly on the browser. TE_GetMenuFile = menuHtml End Function '########################################################### ' ' TE_GetFooterFile ' ' Read the Cookies written by the language.asp ' and then use those as parameters to get a language specific footer. ' ' Important: Return value is a UTF-8 Variant [if the file is a UTF-8 file] ' And to render properly that variant must be writen as a Response.BinaryWrite ' '########################################################### ' ' GetMenu - get the menu from the XML file Function TE_GetFooterFile() Dim username, unittype, appcodes,smCookie,langId langId = Request.Cookies("language_id") If Len(langId) = 0 Then langId = "1" End if Dim footerHtml footerHtml = " Footer not generated - problem with website configureation" Dim fileName fileName = "TE_bodyFooter_" & langId & ".inc" Dim footerFileDir footerFileDir = "/_TEincludes/TEmenu/" 'If Len(footerFileDir) = 0 Then ' footerFileDir = "/_TEincludes/TEmenu/" 'End If Dim foundFile foundfile = False Dim fs Set fs=Server.CreateObject("Scripting.FileSystemObject") fileName = Server.MapPath(footerFileDir & fileName) If (fs.FileExists(fileName))=false Then fileName = Server.MapPath(footerFileDir & "TE_bodyFooter_1.inc") End If If (fs.FileExists(fileName))=true Then Dim file, ts Set file = fs.GetFile(fileName) Const ForReading = 1 Const TristateTrue = -1, TristateDefault = -2 Set ts = file.OpenAsTextStream(ForReading,TristateTrue) footerHtml = ts.ReadAll ts.Close Set ts = Nothing Set file = Nothing End If Set fs = Nothing ' Remember this value is not a typical string - but an UTF-8 string ' so must use Response.BinaryWrite instead of Response.Write to get it ' to display properly on the browser. TE_GetFooterFile = footerHtml End Function '########################################################### ' ' TE_MenuGetUserSpecificMenu ' ' Walk the Menu XML file and get the correct HTML ' Function is called recursively ' Parameters ' theNode - Current Node in the DOM we are processsing - will look only at it's children ' Apps - A String of comma seperated integers indicating the user's authorized SiteMinder applications ' UserName - A SiteMinder provide full user name ' LogOnStatus - A String either "on" or "off" indicating whether SiteMinder thinks user is logged on '########################################################### Function TE_MenuGetUserSpecificMenu(ByRef theNode, Apps, UserName, logOnStatus) '* Dim retHtml ' The return value retHTML = "" ' initialize to empty string Dim child ' Get the children of the current nodes ' Set nodeList = theNode.ChildNodes Set child = theNode.firstChild ' If no children then we are done If child Is Nothing Then retHtml = "" Else ' We have children, let's process them While IsNull(child) = False And Not child Is Nothing Dim currentNode Set currentNode = child ' Determine the node's name - this will tell us what to do with the node Dim currentNodeName currentNodeName = UCase(currentNode.NodeName) ' Force name to Upper Case ' If the node is HTML type then take it's contents and append to our output If currentNodeName = "HTML" Then ' append the contents of the the HTML node to our current output retHtml = retHtml & currentNode.text End if ' If the node is HOSTTYPE type then take it's contents to lookup from the Global ASA ' the actual Protocol/Hostname to use for a link [different in Dev/QA/Prod] 'If currentNodeName = "HOSTTYPE" Then ' Get the name to look up from the node ' Dim serverName ' serverName = currentNode.text ' Look that name up from the GLOBAL ASA and start a link with that as the begining ' of the HREF ' retHtml = retHtml & " tag ' retHtml = retHtml & currentNode.text & """>" 'End If ' After the LINK type we can count on a TEXT node ' Use the contents of the TEXT node to print out the text for the 'If currentNodeName = "TEXT" Then ' append the contents of the TEXT node and close out the tag with a closing ' retHtml = retHtml & currentNode.text & "" & vbCRLF 'End If ' if ( nodeName.compareToIgnoreCase("MENUITEM") == 0 ) { ' If the node is MENUITEM type then want it's children append to our output - so recurse using the current node ' as a starting point 'If currentNodeName = "MENUITEM" Then ' append the contents of the MENUITEM's children ' retHtml = retHtml & TE_MenuGetUserSpecificMenu(currentNode, Apps, UserName, logOnStatus) 'End If ' If the node is SECURE type then want it's children append to our output if the current user is authorized If currentNodeName = "SECURE" Then ' get the apps attribute which has a list of ids, if user has any one of them then they get access ' to this menu item Dim requiredIds requiredIds = currentNode.getAttribute("apps") ' Check to see if the user is authorized If TE_MenuIsUserAuthorized(Apps,requiredIds) = True Then ' append the contents of the SECURE's children retHtml = retHtml & TE_MenuGetUserSpecificMenu(currentNode, Apps, UserName, logOnStatus) End If ' If Authorized End If ' If a Secure TAG ' If the node is SIGNIN type then want it's children append to our output if the User's log in status matches ' the status attribute on the node If currentNodeName = "SIGNIN" Then 'Get the status attribute from the SIGNIN tag Dim statusString statusString = currentNode.getAttribute("status") ' if it matches the user's logon status then append If statusString = logOnStatus Then ' append the contents of the SIGNIN's children retHtml = retHtml & TE_MenuGetUserSpecificMenu(currentNode, Apps, UserName, logOnStatus) End If ' SIGNIN Status matches user's log on status End If ' End if this is a SIGNIN tag ' If the node is USERNAME type then want the actual User's name as determined by the SiteMinder cookies If currentNodeName = "USERNAME" Then ' Append the UserName that was passed into this function retHtml = retHtml + UserName End If Set child = child.nextSibling Wend End If ' Return the Text we got from parsing the file [should be valid HTML to make a menu] TE_MenuGetUserSpecificMenu = retHtml End Function '########################################################### ' ' TE_MenuGetXmlDom ' ' Check the session object for the XMLDOM parser under the name ' 'TE_XMLDOM' ' If present return it, otherwise create it and sock it away on ' the session - this limits how many times the Menu has to be read ' to once per user per session, as opposed to once per page '########################################################### Function TE_MenuGetXmlDom() Dim retObj Dim menuFileLocation,TE_menu_location,TE_menu_file TE_menu_location = Application("TE_MENU_LOCATION") TE_menu_file = Application("TE_MENU_FILE") If( TE_menu_location = "" ) Then TE_menu_location ="/_TEincludes/TEmenu/" End If If ( TE_menu_file = "") Then TE_menu_file = "TE_menu_processed.xml" End If menuFileLocation = Server.MapPath(TE_menu_location&TE_menu_file) Dim foundFile foundfile = False Dim fs, menuFile, menuFileDate, xmlParseDate Set fs=Server.CreateObject("Scripting.FileSystemObject") If fs Is Nothing Or Len(menuFileLocation) < 5 Then Application.Lock Application("TE_DOMERROR") = "Menu configuration file '" & menuFileLocation & "' not found" Application("TE_XMLDOM_DATE") = Nothing Application.Unlock Else If (fs.FileExists(menuFileLocation))=true Then foundFile = True Set menuFile = fs.GetFile(menuFileLocation) menuFileDate = menuFile.DateLastModified xmlParseDate = Application("TE_XMLDOM_DATE") Else foundFile = False Application.Lock Application("TE_XMLDOM_DATE") = Nothing Application.Unlock End If End If If xmlParseDate >= menuFileDate Then If IsObject(Application("TE_XMLDOM")) Then Set retObj = Application("TE_XMLDOM") Response.Write("") Else Response.Write("") Set retObj = Nothing End If Else Set retObj = Nothing Response.Write("") End if If retObj Is Nothing Then Application.Lock Application("TE_XMLDOM_DATE") = Now Set Application("TE_XMLDOM") = Server.CreateObject("Microsoft.FreeThreadedXMLDOM") Application.Unlock Set retObj = Application("TE_XMLDOM") retObj.async = False If foundFile = True Then retObj.load (menuFileLocation) End If End If set fs= Nothing Set menuFile = Nothing Set TE_MenuGetXmlDom = retObj End Function '########################################################### ' ' TE_GetMenu ' ' Read the Cookies written by the secure/commerce.asp ' and then use those as parameters to get a user specific ' menu. ' '########################################################### ' ' GetMenu - get the menu from the XML file Function TE_GetMenu() Dim username, unittype, appcodes,smCookie,langId username = Request.Cookies("TECewt2") unittype = Request.Cookies("TECewt3") appcodes = TE_GetApplicationCodes() smCookie = Request.Cookies("SMSESSION") langId = Request.Cookies("language_id") Dim logOnStatus logOnStatus = "off" If Len(smCookie) > 1 And smCookie <> "LOGGEDOFF" Then logOnStatus = "on" End If If Len(langId) = 0 Then langId = "1" End if Dim menuHtml menuHtml = " Menu not generated - problem with website configureation" Dim xmlDoc Set xmlDoc = TE_MenuGetXmlDom() 'Set xmlDoc = Application("TE_XMLDOM") 'If xmlDoc2 Is xmlDoc Then ' Response.Write("") 'End if Dim elementsList 'Set elementsList = Dim menuNode Set menuNode = TE_MenuGetLanguageElement(xmlDoc,langId) If menuNode Is Nothing Then Response.Write("") Else menuHtml = TE_MenuGetUserSpecificMenu(menuNode, appcodes, username, logOnStatus) End if Set elementsList = Nothing Set menuNode = Nothing Set xmlDoc = Nothing TE_GetMenu = menuHtml End Function '########################################################### ' ' TE_FooterGetXmlDom ' ' Check the session object for the XMLDOM parser under the name ' 'TE_FOOTER_XMLDOM' ' If present return it, otherwise create it and sock it away on ' the session - this limits how many times the Menu has to be read ' to once per user per session, as opposed to once per page '########################################################### Function TE_FooterGetXmlDom() Dim retObj Dim objCheck, nothingCheck objCheck = IsObject(Application("TE_FOOTER_XMLDOM")) If objCheck Then Set retObj = Application("TE_FOOTER_XMLDOM") If retObj Is Nothing Then nothingCheck = True Else nothingCheck = false End if End If If( objCheck = False Or nothingCheck = True ) Then Application.Lock Set Session("TE_FOOTER_XMLDOM") = Server.CreateObject("Microsoft.FreeThreadedXMLDOM") Application.Unlock Set retObj = Session("TE_FOOTER_XMLDOM") retObj.async = False Dim footerFileLocation footerFileLocation = Server.MapPath(Application("TE_FOOTER_LOCATION")&Application("TE_FOOTER_FILE")) Dim foundFile foundfile = False Dim fs Set fs=Server.CreateObject("Scripting.FileSystemObject") If fs Is Nothing Or Len(footerFileLocation) < 5 Then Application.Lock Application("TE_DOMERROR") = "Footer configuration file '" & footerFileLocation & "' not found" Application.Unlock Else If (fs.FileExists(footerFileLocation))=true Then foundFile = True End If End If set fs=nothing If foundFile = True Then retObj.load (footerFileLocation) End If Else Set retObj = Application("TE_FOOTER_XMLDOM") End if Set TE_FooterGetXmlDom = retObj End Function '########################################################### ' ' TE_GetFooter ' ' Read the Cookies written by the secure/commerce.asp ' and then use those as parameters to get a user specific ' menu. ' '########################################################### ' ' GetMenu - get the menu from the XML file Function TE_GetFooter() Dim langId langId = Request.Cookies("language_id") If Len(langId) = 0 Then langId = "1" End If Dim footer_cache footer_cache = "TE_FOOTER_CACHE_" & langId Dim footerHtml footerHtml = Application(footer_cache) If Len(footerHTML) < 1 Then Response.Write("") Dim xmlDoc set xmlDoc = TE_FooterGetXmlDom() If xmlDoc Is Nothing Then footerHtml = " Unable to generate footer - " & Application("TE_DOMERROR") Else Dim footerNode Set footerNode = TE_MenuGetLanguageElement(xmlDoc,langId) footerHtml = TE_MenuGetUserSpecificMenu(footerNode, "", "", "off") Set footerNode = Nothing Set xmlDoc = Nothing End If Application.Lock Application(footer_cache) = footerHtml Application.Unlock Else Response.Write("") End If TE_GetFooter = footerHtml End Function '########################################################### ' ' TE_UpdateTECewt1 ' ' Read the headers written by SiteMinder to ' generate the correct application codes and write them ' to TECewt1 cookie via JavaScript ' '########################################################### ' ' GetMenu - get the menu from the XML file Sub TE_UpdateTECewt1() Dim smCookie, TECewt1, smAuthType 'Response.Write(" " & vbCrLf ) ' Get the SMSESSION cookie - it tells us if we are logged on... smCookie = Request.Cookies("SMSESSION") TECewt1 = Request.Cookies("TECewt1") ' if SMSESSION is present and not equal to LOGGEDOFF has length then we are logged on... If Len(smCookie) > 1 And smCookie <> "LOGGEDOFF" And Len(TECewt1) < 1 Then 'Response.Write(" " & vbCrLf ) smAuthType = TE_GetAttribute("SM_AUTHTYPE") ' get the request header to indicate whether we are on a secure page 'Response.Write(" " & vbCrLf ) ' we have some value If Len(smAuthType) > 1 Then 'Response.Write(" " & vbCrLf ) Dim uSmAuthType uSmAuthType = UCase(smAuthType) ' and case insensitive does not match the phrase "Not Protected" then If Not uSmAuthType = "NOT PROTECTED" Then 'Response.Write(" " & vbCrLf ) ' We are at a secure ASP page - get the APPCODES TECewt1 = TE_GetApplicationCodes ' Write out to the page the JavaScript needed to properly set the TECewt1 cookie values Response.Write("" & vbCrLf) End If End If End if End Sub '########################################################### ' ' TE_GetApplicationCodes ' ' Determine whether to get the Application Codes from SiteMinder Headers directly ' Or get the values from TECewt1 cookie ' '########################################################### ' ' GetMenu - get the menu from the XML file Function TE_GetApplicationCodes() Dim smCookie, TECewt1, smAuthType 'Response.Write(" " & vbCrLf ) ' Get the SMSESSION cookie - it tells us if we are logged on... smCookie = Request.Cookies("SMSESSION") TECewt1 = Request.Cookies("TECewt1") ' if SMSESSION is present and not equal to "LOGGEDOFF" then we are logged on... If Len(smCookie) > 1 And smCookie <> "LOGGEDOFF" Then 'Response.Write(" " & vbCrLf ) smAuthType = TE_GetAttribute("SM_AUTHTYPE") ' get the request header to indicate whether we are on a secure page 'Response.Write(" " & vbCrLf ) ' we have some value If Len(smAuthType) > 1 Then 'Response.Write(" " & vbCrLf ) Dim uSmAuthType uSmAuthType = UCase(smAuthType) ' and case insensitive does not match the phrase "Not Protected" then If Not uSmAuthType = "NOT PROTECTED" Then 'Response.Write(" " & vbCrLf ) ' We are at a secure ASP page - get the APPCODES TECewt1 = TE_GetAttribute("APPCODES") ' Check to see if the USERDN for this logged on user indicates that user is Customer or Employee... dim dnRegExp : set dnRegExp = new RegExp ' create reg exp dnRegExp.Global = true dnRegExp.IgnoreCase = true dnRegExp.pattern = "%2Cou%3D(Employees)%2C|%2Cou%3D(Customers)%2C|,ou=(Employees),|,ou=(Customers),|(Employees)|(Customers)" Dim Matches Set Matches = dnRegExp.Execute(TE_GetAttribute("SM_USERDN")) If Matches.count = 1 Then If Len(TECewt1) > 0 Then TECewt1 = TECewt1 & ";PCN" Else TECewt1 = "PCN" End if End If End if End If End If TE_GetApplicationCodes = TECewt1 End Function '********************************************************************** ' FUNCTION PROCEDURE DEFINITONS ' - GetAttribute() : Get http header variable, attribute name ' '********************************************************************** Function TE_GetAttribute(AttrName) '* get http header variable, attribute name Dim AllAttrs Dim RealAttrName Dim firstCharLocation Dim Result Dim finalResult finalResult = "" AllAttrs = Request.ServerVariables("ALL_HTTP") 'Response.Write("" & vbCrLf) 'Response.Write("" & vbCrLf) RealAttrName = "HTTP_" & ucase(AttrName) 'Response.Write("" & vbCrLf) 'Response.Write("" & vbCrLf) firstCharLocation = instr(AllAttrs, RealAttrName & ":") 'Response.Write("" & vbCrLf) if firstCharLocation <= 0 then TE_GetAttribute = finalResult Exit Function end if Result = mid(AllAttrs, firstCharLocation + Len(RealAttrName) + 1) 'Response.Write("" & vbCrLf) firstCharLocation = instr(Result, chr(10)) 'Response.Write("" & vbCrLf) if firstCharLocation <= 0 then firstCharLocation = len(Result) + 1 finalResult = left(Result, firstCharLocation - 1) 'Response.Write("" & vbCrLf) TE_GetAttribute = finalResult End Function %> Skip to content
 |  Tyco Electronics Segment Indicator  |   | 
Tyco Electronics - Our commitment. Your advantage.
Visit www.tycoelectronics.com Application Tooling
<% dim breadCrumbLabels, breadCrumbURLs breadCrumbURLs = Array("/", "applicator.asp") breadCrumbLabels = Array("Home", "Lead-Makers") TE_displayBreadCrumb breadCrumbURLs, breadCrumbLabels %> Tyco Electronics - Tooling If you are not redirected to the new site after 3 seconds, click here :http://tooling.tycoelectronics.com/lead_maker.asp