AI-ASP-CLASSIC/Core/App.asp

<%
Class App
    Private m_Route
    Private m_Method
    Private m_ServerName
    Private m_ServerPort
    Private m_PhysicalRoot
    Private m_StartedAt
    Private m_Services
    Private m_Request

    Private Sub Class_Initialize()
        m_Route = "/"
        m_Method = "GET"
        m_ServerName = ""
        m_ServerPort = ""
        m_PhysicalRoot = ""
        m_StartedAt = Now()
        Set m_Services = Server.CreateObject("Scripting.Dictionary")
        m_Services.CompareMode = 1
        Set m_Request = Nothing
    End Sub

    Private Sub Class_Terminate()
        Set m_Request = Nothing
        Set m_Services = Nothing
    End Sub

    Public Sub SetRequest(ByRef requestObject)
        ' IsObject(Nothing) is True in VBScript, so it can't detect "no object"
        ' on its own - it must be paired with an explicit "Is Nothing" check.
        If (Not IsObject(requestObject)) Or (requestObject Is Nothing) Then
            Err.Raise vbObjectError + 1003, "App.SetRequest", "requestObject must be an object."
        End If

        Set m_Request = requestObject
    End Sub

    Public Sub Boot()
        EnsureRequest
        m_Method = m_Request.ServerVariable("REQUEST_METHOD")
        m_ServerName = m_Request.ServerVariable("SERVER_NAME")
        m_ServerPort = m_Request.ServerVariable("SERVER_PORT")
        m_PhysicalRoot = Server.MapPath("/")
        m_Route = ResolveRoute()
    End Sub

    Public Sub RegisterInstance(ByVal serviceName, ByRef serviceInstance)
        If Len(Trim(CStr(serviceName))) = 0 Then
            Err.Raise vbObjectError + 1000, "App.RegisterInstance", "serviceName is required."
        End If

        If m_Services.Exists(CStr(serviceName)) Then
            m_Services.Remove CStr(serviceName)
        End If

        Set m_Services.Item(CStr(serviceName)) = serviceInstance
    End Sub

    Public Function Resolve(ByVal serviceName)
        If Not m_Services.Exists(CStr(serviceName)) Then
            Err.Raise vbObjectError + 1001, "App.Resolve", "Service not registered: " & CStr(serviceName)
        End If

        Set Resolve = m_Services.Item(CStr(serviceName))
    End Function

    Public Function HasService(ByVal serviceName)
        HasService = m_Services.Exists(CStr(serviceName))
    End Function

    Public Sub InjectInto(ByRef targetObject)
        If (Not IsObject(targetObject)) Or (targetObject Is Nothing) Then
            Err.Raise vbObjectError + 1002, "App.InjectInto", "targetObject must be an object."
        End If

        On Error Resume Next
        CallByName targetObject, "SetApp", VbMethod, Me
        On Error GoTo 0
    End Sub

    Public Property Get Route()
        Route = m_Route
    End Property

    Public Property Get RequestMethod()
        RequestMethod = m_Method
    End Property

    Public Property Get ServerName()
        ServerName = m_ServerName
    End Property

    Public Property Get ServerPort()
        ServerPort = m_ServerPort
    End Property

    Public Property Get PhysicalRoot()
        PhysicalRoot = m_PhysicalRoot
    End Property

    Public Property Get StartedAt()
        StartedAt = m_StartedAt
    End Property

    Public Property Get HttpRequest()
        EnsureRequest
        Set HttpRequest = m_Request
    End Property

    Public Function ServiceNames()
        ServiceNames = m_Services.Keys
    End Function

    Private Function ResolveRoute()
        Dim originalUrl
        Dim pathInfo
        Dim queryIndex

        EnsureRequest

        ' Public/web.config rewrites every request to Default.asp, so PATH_INFO
        ' inside this page is always empty/"/Default.asp" - it never reflects what
        ' was actually requested. IIS's URL Rewrite module stores the real request
        ' path in HTTP_X_ORIGINAL_URL before rewriting, so prefer that when present.
        originalUrl = Trim(CStr(m_Request.ServerVariable("HTTP_X_ORIGINAL_URL")))

        If Len(originalUrl) > 0 Then
            queryIndex = InStr(originalUrl, "?")
            If queryIndex > 0 Then
                originalUrl = Left(originalUrl, queryIndex - 1)
            End If

            If LCase(originalUrl) = "/default.asp" Then
                ResolveRoute = "/"
            Else
                ResolveRoute = originalUrl
            End If

            Exit Function
        End If

        pathInfo = Trim(CStr(m_Request.ServerVariable("PATH_INFO")))

        If Len(pathInfo) = 0 Then
            ResolveRoute = "/"
            Exit Function
        End If

        If LCase(pathInfo) = "/default.asp" Then
            ResolveRoute = "/"
            Exit Function
        End If

        ResolveRoute = pathInfo
    End Function

    Private Sub EnsureRequest()
        If m_Request Is Nothing Then
            Err.Raise vbObjectError + 1004, "App.EnsureRequest", "No request object has been injected into the app."
        End If
    End Sub
End Class
%>