(sURL, "URLBase", sURLBase) Call SA_MungeURL(sURL, SAI_FLD_PAGEKEY, SAI_GetPageKey()) Randomize Call SA_MungeURL(sURL, "R", CStr(Rnd())) %>   <% Response.End End Function '---------------------------------------------------------------------------- ' ' Function : Redirect ' ' Synopsis : Redirect to given URL ' ' Arguments: URL(IN) - URL to redirect to ' ' Returns : None ' '---------------------------------------------------------------------------- Function Redirect(URL) %>   <% End Function '---------------------------------------------------------------------------- ' ' Function : SwapRows ' ' Synopsis : Swap routine used by QuickSort ' ' Arguments: arr(IN) - array whose row needs to be swapped ' row1(IN) - row to swap ' row2(IN) - row to swap ' ' Returns : None ' '---------------------------------------------------------------------------- Sub SwapRows(ary,row1,row2) '== This proc swaps two rows of an array Dim x,tempvar For x = 0 to Ubound(ary,2) tempvar = ary(row1,x) ary(row1,x) = ary(row2,x) ary(row2,x) = tempvar Next End Sub 'SwapRows '---------------------------------------------------------------------------- ' ' Function : QuickSort ' ' Synopsis : the quick sort algorithm ' ' Arguments: vec(IN) - array whose row needs to be swapped ' loBound(IN) - lower bound of array vec ' hiBound(IN) - upped bound of array vec ' SortField(IN) - the field to sort on ' ' Returns : None ' '---------------------------------------------------------------------------- Sub QuickSort(vec, loBound, hiBound, SortField) Dim pivot(),loSwap,hiSwap,temp,counter Redim pivot (Ubound(vec,2)) '== Two items to sort if hiBound - loBound = 1 then if vec(loBound,SortField) > vec(hiBound,SortField) then Call SwapRows(vec,hiBound,loBound) End If '== Three or more items to sort For counter = 0 to Ubound(vec,2) pivot(counter) = vec(int((loBound + hiBound) / 2),counter) vec(int((loBound + hiBound) / 2),counter) = vec(loBound,counter) vec(loBound,counter) = pivot(counter) Next loSwap = loBound + 1 hiSwap = hiBound do '== Find the right loSwap while loSwap < hiSwap and vec(loSwap,SortField) <= pivot(SortField) loSwap = loSwap + 1 wend '== Find the right hiSwap while vec(hiSwap,SortField) > pivot(SortField) hiSwap = hiSwap - 1 wend '== Swap values if loSwap is less then hiSwap if loSwap < hiSwap then Call SwapRows(vec,loSwap,hiSwap) loop while loSwap < hiSwap For counter = 0 to Ubound(vec,2) vec(loBound,counter) = vec(hiSwap,counter) vec(hiSwap,counter) = pivot(counter) Next '== Recursively call function .. the beauty of Quicksort '== 2 or more items in first section if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1,SortField) '== 2 or more items in second section if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound,SortField) End Sub 'QuickSort '---------------------------------------------------------------------------- ' ' Function : getVirtualDirectory ' ' Synopsis : Gets the virtual directory where the serverappliance is installed. ' ' Arguments: None ' ' Returns : The virtual directory where serverappliance is installed. ' '---------------------------------------------------------------------------- Function getVirtualDirectory getVirtualDirectory = "/admin/" 'Dim strVDir,strFinal 'Dim idx 'strVDir = Request.ServerVariables("APPL_MD_PATH") 'idx = instr(2,strVDir,"ROOT",1) 'strFinal=mid(strVDir,idx+4) 'If strFinal<>"" Then ' strFinal=strFinal& "/" 'else ' strFinal ="/" 'End IF 'getVirtualDirectory=strFinal End Function '---------------------------------------------------------------------------- ' ' Function : SA_GetCurrentURL ' ' Synopsis : Gets the current url including query string ' ' Arguments: None ' ' Returns : The current url including query string ' '---------------------------------------------------------------------------- Public Function SA_GetCurrentURL() SA_GetCurrentURL = Request.ServerVariables("URL") + "?" + Request.ServerVariables("QUERY_STRING") End Function '------------------------------------------------------------------------- 'Function name: CheckForSecureSite 'Description: 'Output Variables: None 'Returns: None '------------------------------------------------------------------------- Sub CheckForSecureSite() Dim objContextHelp Dim objElement Dim strHelpURL Dim strSecureURL Dim strURL Dim L_WARN_TO_USE_HTTPS Dim L_WARN_TO_INSTALL_CERT Dim L_SECURE_SITE_LINK_PROMPT L_WARN_TO_INSTALL_CERT = GetLocString("sacoremsg.dll", "&H402003EB", "") Dim sHelpRoot Call SA_GetHelpRootDirectory(sHelpRoot) 'strHelpURL = sHelpRoot + "_nas_HTTPS__Creating_a_Secure_Connection.htm" ' No SSL Certificate case If ( FALSE = SAI_IsSSLCertificateInstalled()) Then Response.write ("
" & L_WARN_TO_INSTALL_CERT & " " & "
" ) ' Not using https warn use to use https ElseIf LCASE( Request.ServerVariables("HTTPS") ) = "off" Then Dim sSecureWebSite Dim sSecurePort Dim aRepString(1) sSecurePort = SAI_GetSecurePort() If ( sSecurePort > 0 ) Then aRepString(0) = CStr(sSecurePort) L_WARN_TO_USE_HTTPS = GetLocString("sacoremsg.dll", "&H402003E9", aRepString) sSecureWebSite = SA_GetNewHostURLBase("", sSecurePort, TRUE, "") Call SA_TraceOut("SH_PAGE", "Secure URL: " + sSecureWebSite) If ( Len(sSecureWebSite) > 0 ) Then L_SECURE_SITE_LINK_PROMPT = GetLocString("sacoremsg.dll", "402003EC", "") End If Else L_WARN_TO_USE_HTTPS = GetLocString("sacoremsg.dll", "&H402003EA", "") End If strURL = "javascript:OpenRawPage('" & sSecureWebSite & "' );" Response.write ("
" & "
" & L_WARN_TO_USE_HTTPS & ""+L_SECURE_SITE_LINK_PROMPT+"" ) Response.Write("
" ) End If End Sub '---------------------------------------------------------------------------- ' ' Function : SA_ServeFailurePage ' ' Synopsis : Serve the page which redirects the browser to the err_view.asp ' failure page ' ' Arguments: Message(IN) - message to be displayed by err_view.asp ' ' Returns : None ' '---------------------------------------------------------------------------- Public Function SA_ServeFailurePage(ByVal Message) Call SA_ServeFailurePageEx(Message, mstrReturnURL) End Function '---------------------------------------------------------------------------- ' ' Function : SA_ServeFailurePageEx ' ' Synopsis : Serve the page which redirects the browser to the err_view.asp ' failure page ' ' Arguments: [in] Message - Message that will be displayed in the error page ' [in] ReturnURL - URL that should be navigated to when the user ' clicks the OK button. If this value is SA_DEFAULT ' the default home page will be used. ' ' Returns : None ' '---------------------------------------------------------------------------- Public Function SA_ServeFailurePageEx(ByVal Message, sReturnPage) Dim sReturnURL Dim sFailurePageURL Const MINIMUM_VALID_URL = 3 Response.Clear sReturnURL = sReturnPage If ( Len(sReturnURL) <= MINIMUM_VALID_URL ) Then sReturnURL = m_VirtualRoot + "default.asp" Else ' ' Make sure ReturnURL has the virtual root prepended If ( Left(sReturnURL, Len("http://")) = "http://" OR Left(sReturnURL, Len("https://")) = "https://" ) Then ' ' ReturnURL is fully qualified ' ElseIf ( Left(sReturnURL, 1) <> "/" ) Then ' ' Prepend the virtual root ' sReturnURL = m_VirtualRoot + sReturnURL End If End If Randomize() Call SA_MungeURL(sReturnURL, "R", ""+CStr(Rnd())) sFailurePageURL = m_VirtualRoot + "util/err_view.asp" Call SA_MungeURL( sFailurePageURL, "Message", Message) Call SA_MungeURL( sFailurePageURL, "ReturnURL", sReturnURL) Call SA_TraceOut(SA_GetScriptFileName(), "SA_ServeFailurePage redirecting to: " + sFailurePageURL) %>
<% Response.Flush Response.End End Function '-------------------------------------------------------------------- ' ' Function: SA_MungeURL ' ' Synopsis: Munge the specified URL, to add, update, or delete the specified ' parameter. This function will URLEncode the sParamValue parameter, ' DO NOT Server.URLEncode(sParamValue) before passing to this function. ' ' To delete a parameter value from the URL, specify the parameter name ' and a blank value as in: ' Call SA_MungURL(sURL, "FavoriteFood", "") ' ' To add or update a parameter to the URL, specify the parameter name ' and a valid non-blank value as in: ' Call SA_MungeURL(sURL, "FavoriteFood", "ApplePie") ' ' Arguments: [in/out] sURL - URL that is to be Munged, or updated. ' [in] sParamName - Name of parameter that is to be changed ' or added. ' [in] sParamValue - Value of the parameter ' ' Returns: Nothing ' ' Example: ' Dim sURLExample ' Dim sOutput ' ' sURLExample = "http://localhost/Tasks.asp?Param1=Red&Param2=Peach&Param3=Bird" ' sOutput = "Starting with: " + sURLExample + vbCrLf ' ' Call SA_MungeURL(sURLExample, "Param1", "Green") ' sOutput = sOutput + sURLExample + vbCrLf ' ' Call SA_MungeURL(sURLExample, "Param1", "Blue") ' sOutput = sOutput + sURLExample + vbCrLf ' ' Call SA_MungeURL(sURLExample, "Param3", "Dog") ' sOutput = sOutput + sURLExample + vbCrLf ' ' Call SA_MungeURL(sURLExample, "Param2", "Pear") ' sOutput = sOutput + sURLExample + vbCrLf ' ' Call SA_MungeURL(sURLExample, "Param4", "Software") ' sOutput = sOutput + sURLExample + vbCrLf ' ' WScript.Echo sOutput ' '-------------------------------------------------------------------- Public Function SA_MungeURL(ByRef sURL, ByVal sParamName, ByVal sParamValue) Dim rc SA_MungeURL = 0 ' ' Strip off leading ?, & parameter token if it exists. ' We are going to check for both cases in the URL. ' sParamName = SA_StripParamToken(sParamName) ' ' Strip leading and trailing spaces ' sParamName = Trim(sParamName) sParamValue = Trim(sParamValue) ' ' Is this a delete parameter request ' If (Len(sParamValue) <= 0 ) Then ' ' Look for parameter using the ? token ' rc = SA_DelURLParamInternal(sURL, "&"+sParamName) If ( rc <> TRUE ) Then ' ' Look for parameter using the "?" token ' Call SA_DelURLParamInternal(sURL, "?"+sParamName) End If Exit Function End If ' ' URL Encode the parameter value ' sParamValue = Server.URLEncode(sParamValue) ' ' Look for matching param starting with "&" token ' rc = SA_SetURLParamInternal(sURL, "&"+sParamName, sParamValue) If ( rc <> TRUE ) Then ' ' Look for matching param starting with "?" token ' rc = SA_SetURLParamInternal(sURL, "?"+sParamName, sParamValue) If ( rc <> TRUE ) Then ' ' Param did not exist in the URL, add it ' If InStr(sURL, "?") Then sURL = sURL + "&" + sParamName + "=" + sParamValue Else sURL = sURL + "?" + sParamName + "=" + sParamValue End If End If End If End Function Public Function SA_SetURLParamInternal(ByRef sURL, ByVal sParamName, ByVal sParamValue) SA_SetURLParamInternal = FALSE Dim i Dim sUrl1 Dim sUrl2 ' ' Do Case insensitive search, starting in the first position ' i = InStr(1, sURL, sParamName+"=", 1) If ( i > 0 ) Then sURL1 = Left(sURL, i - 1) sURL2 = Mid(sURL, i + 1) i = InStr(sURL2, "&") If ( i > 0 ) Then sURL2 = Mid( sURL2, i ) Else sURL2 = "" End If If InStr(sURL1, "?") Then sURL = sURL1 + "&" + SA_StripParamToken(sParamName) + "=" + sParamValue + sURL2 Else sURL = sURL1 + "?" + SA_StripParamToken(sParamName) + "=" + sParamValue + sURL2 End If SA_SetURLParamInternal = TRUE End If End Function Public Function SA_DelURLParamInternal(ByRef sURL, ByVal sParamName) SA_DelURLParamInternal = FALSE Dim i Dim sUrl1 Dim sUrl2 ' ' Do Case insensitive search, starting in the first position ' i = InStr(1, sURL, sParamName+"=", 1) If ( i > 0 ) Then sURL1 = Left(sURL, i - 1) sURL2 = Mid(sURL, i + 1) i = InStr(sURL2, "&") If ( i > 0 ) Then sURL2 = Mid( sURL2, i ) Else sURL2 = "" End If If InStr(sURL1, "?") Then sURL = sURL1 + sURL2 ElseIf (Len(sURL2) > 0 ) Then sURL = sURL1 + "?" + SA_StripParamToken(sURL2) Else sURL = sURL1 End If SA_DelURLParamInternal = TRUE End If End Function Public Function SA_StripParamToken(ByRef sParam ) If (Left(sParam,1) = "?") OR (Left(sParam,1) = "&") Then SA_StripParamToken = Mid(sParam, 2) Else SA_StripParamToken = sParam End If End Function Private Function SAI_IsSSLCertificateInstalled() on error resume next Err.Clear Dim oWebServer Dim sAdminSiteID SAI_IsSSLCertificateInstalled = FALSE 'sAdminSiteID = SAI_GetWebSiteID("Administration" ) sAdminSiteID = GetCurrentWebsiteName() Call SA_TraceOut("SH_PAGE", "SAI_IsSSLCertificateInstalled - Checking for SSL Certificate on site ID: " + sAdminSiteID) Set oWebServer = GetObject( "IIS://localhost/" + sAdminSiteID ) If (Len(oWebServer.SSLStoreName) > 0 ) Then Call SA_TraceOut("SH_PAGE", "SSL Certificate found") SAI_IsSSLCertificateInstalled = TRUE End IF Set oWebServer = Nothing End Function Function SAI_GetSecurePort() On Error Resume Next Err.Clear Dim strSitename Dim objService Dim objWebsite Dim strObjPath Dim strSSLPort Dim strIPArr SAI_GetSecurePort = 0 strSitename = GetCurrentWebsiteName() 'strSitename = SAI_GetWebSiteID("Administration" ) strObjPath = GetIISWMIProviderClassName("IIs_WebServerSetting") & ".Name=" & chr(34) & strSitename & chr(34) Set objService = GetWMIConnection(CONST_WMI_IIS_NAMESPACE) Set objWebsite = objService.get(strObjPath) If IsIIS60Installed() Then strSSLPort = objWebsite.SecureBindings(0).Port strSSLPort = Left(strSSLPort, len(strSSLPort)-1) Else strIPArr=split(objWebsite.SecureBindings(0),":") strSSLPort = strIPArr(1) End If If Err.number <> 0 Then SA_TraceOut "SH_PAGE", "SAI_GetSecurePort(): failed:" + CStr(Hex(Err.Number)) Exit Function End If SAI_GetSecurePort = strSSLPort Call SA_TraceOut("sh_page", "SAI_GetSecurePort() returning: " & SAI_GetSecurePort ) End Function %>