<% 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 %>