Chip 1999 September/CHIPCD_9_99.iso/software/uaktualnienia/OptionPackPL/iis4_07.cab/libGlobalFuncs.inc

Text File | 1998-04-27 | 5.3 KB | 183 lines

<% ' This module contains useful global functions %>
<%
    ' GetServerName returns a fully qualified server name
    Function GetServerName
        GetServerName = "http://" & Request.ServerVariables("SERVER_NAME")
    End Function
%>

<%
    ' GetPrefixValue is a helper function which removes the
    ' document name from a fully-qualified URL
    Function GetPrefixValue
        Dim strFullPath, strLastChar
        strFullPath = "http://"
        strFullPath = strFullPath & Request.ServerVariables("SERVER_NAME")
        strFullPath = strFullPath & Request.ServerVariables("PATH_INFO")
        ' now str has a value like: "http://servname/exair/freqflyer/default.asp"
        ' we need to cut off the "/default.asp" part
        strLastChar = ""
        Do Until strLastChar = "/"
            strLastChar = right(strFullPath, 1)
            strFullPath = left(strFullPath, len(strFullPath) - 1)
        Loop
        GetPrefixValue = strFullPath
    End Function
%>

<%
    ' GetSecurePrefixValue is a helper function like GetPrefixValue
    ' but it prepends an http:// rather than http://
    Function GetSecurePrefixValue
        Dim strFullPath, strLastChar
        strFullPath = "https://"
        strFullPath = strFullPath & Request.ServerVariables("SERVER_NAME")
        strFullPath = strFullPath & Request.ServerVariables("PATH_INFO")
        ' now str has a value like: "https://servname/exair/freqflyer/default.asp"
        ' we need to cut off the "/default.asp" part
        strLastChar = ""
        Do Until strLastChar = "/"
            strLastChar = right(strFullPath, 1)
            strFullPath = left(strFullPath, len(strFullPath) - 1)
        Loop
        GetSecurePrefixValue = strFullPath
    End Function
%>

<%
    ' Homepage is a helper function which returns the fully-qualifed URL of the home page
    ' strPathOffset is used in case the calling page is not in the same directory as default.asp
    Function Homepage(strPathOffset)
        Dim strHomepage

        strHomepage = GetPrefixValue()
        strHomepage = strHomepage & "/" & strPathOffset & "/Default.asp"
        Homepage = strHomepage

    End Function
%>

<%
Function GetRootURL()
  Dim FullPath, StartExAir
  ' Get path to where we are now
  FullPath = GetPrefixValue()
  ' Now walk back up to Exair
  StartExAir = InStr(1, FullPath, "ExAir", 1)
  GetRootURL = Left(FullPath, StartExAir + 4)
End Function
%>

<%
    ' Helper functions to support global security ExAir policy
    Function AllowAnon
        AllowAnon = Application("AdminAllowAnonymous")
    End Function

    Function UseSSLOnFreqFlyer
        UseSSLOnFreqFlyer=Application("AdminUseSSLOnFreqFlyer")
    End Function

    Function UseSSLOnBusinessPartners
        UseSSLOnBusinessPartners=Application("AdminUseSSLOnBusinessPartners")
    End Function
%>

<%
    ' IsCertificateServerInstalled returns True if CertSrv installed, False otherwise
    ' We determine if it's installed by looking for the ixsso.query component
    Function IsCertificateServerInstalled()
        IsCertificateServerInstalled = False
        On Error Resume Next

        Dim oCertSrv
        Set oCertSrv = Server.CreateObject("CertificateAuthority.Config")
        If Err = 0 Then
            IsCertificateServerInstalled = True
        End If

        Set oCertSrv = Nothing
    End Function
%>

<%
    ' IsPostingAcceptorInstalled returns True if WebPost is installed, False otherwise
    ' We determine if it's installed by looking for the CPSHost.dll in servername/scripts
    Function IsPostingAcceptorInstalled()
        IsPostingAcceptorInstalled = False
        On Error Resume Next

        Dim oFS, strPath, booExists
        Set oFS = Server.CreateObject("Scripting.FileSystemObject")
        strPath = "/scripts/cpshost.dll"
        booExists = oFS.FileExists(Server.MapPath(strPath))
        If Err = 0 And booExists Then
            IsPostingAcceptorInstalled = True
        End If

    End Function
%>

<%
    ' IsIndexServerInstalled returns True if IS installed, False otherwise
    ' We determine if it's installed by looking for the ixsso.query component
    Function IsIndexServerInstalled()
        IsIndexServerInstalled = False
        On Error Resume Next

        Dim oIS
        Set oIS = Server.CreateObject("ixsso.Query")
        If Err = 0 Then
            IsIndexServerInstalled = True
        End If

        Set oIS = Nothing

    End Function
%>

<%
    ' CanAdminServer
    ' Can the user admin this server? This is determed by trying a dummy call to ADSI
    Function CanAdminServer()
        On Error Resume Next
        Dim oADSI
        Set oADSI = GetObject("IIS://localhost/w3svc/1/Root")
        If Err = 0 Then
            CanAdminServer = True
        Else
            CanAdminServer = False
        End If
    End Function
%>

<%
    ' HasAccess determines if the user has access to the named directory/file
    Function HasAccess(strDir)
        On Error Resume Next
        HasAccess = False
        Dim pmck
        Set pmck = Server.CreateObject("MSWC.PermissionChecker")
        If Err = 0 Then
            HasAccess = pmck.HasAccess(strDir)
        End If
    End Function
%>

<%
    Function SaveAdminPrefs()
        On Error Resume Next

        Dim fso, txtSettings
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        Set txtSettings = fso.CreateTextFile(Server.MapPath("AdminPrefs.txt"), True, False)
        If Err = 0 Then
            'Write the specified Application variables to the text file
            txtSettings.WriteLine "AdminAllowAnonymous" & "=" & CInt(Application("AdminAllowAnonymous"))
            txtSettings.WriteLine "AdminUseSSLOnFreqFlyer" & "=" & CInt(Application("AdminUseSSLOnFreqFlyer"))
            txtSettings.WriteLine "AdminUseSSLOnBusinessPartners" & "=" & CInt(Application("AdminUseSSLOnBusinessPartners"))
        End If

        txtSettings.Close
    End Function
%>