<% '!--Microsoft Outlook Web Access--> '!--Logon.inc - Logon functions--> '!--Copyright (c) Microsoft Corporation 1993-1997. All rights reserved.--> '======================= ' ReloadAnonSession ' Create a new anonymous connection to the DS ' '======================= Public Function ReloadAnonSession On Error Resume Next Set ReloadAnonSession= Nothing Set objRenderApp = Application("RenderApplication") hOldImp = objRenderApp.ImpID objRenderApp.Impersonate(0) Set objAnonSession = Server.CreateObject("MAPI.Session") If Err = 0 Then bstrExchOrg = objRenderApp.ConfigParameter("Enterprise") bstrExchSite = objRenderApp.ConfigParameter("Site") bstrExchServer = objRenderApp.ConfigParameter("Server") bstrExchServDN = "/o=" + bstrExchOrg + "/ou=" + bstrExchSite +_ "/cn=Configuration/cn=Servers/cn=" + bstrExchServer bstrProfileInfo = bstrExchServDN + vbLF + "anon" + vbLF + "anon" objAnonSession.Logon "", "", False, True, 0, True, bstrProfileInfo If Err = 0 Then Randomize bstrObj = cstr(int(100000 * Rnd())) Set Application(bstrObj)= objAnonSession Set Application("AMAnonSession") = objAnonSession Else Set objAnonSession = Nothing End If End If objRenderApp.Impersonate(hOldImp) Set ReloadAnonSession= objAnonSession End Function '======================= ' AuthenticateUser ' Ensures user is authenticated ' '======================= Public Function BAuthenticateUser On Error Resume Next BAuthenticateUser = False bstrAT = Request.ServerVariables("AUTH_TYPE") If InStr(1, bstrAuthTypesAccepted, bstrAT, vbTextCompare) < 2 Then Response.Buffer = TRUE Response.Status = ("401 Unauthorized") Response.End Else BAuthenticateUser = True End If End Function '======================= ' AccountDisabled ' Checks account property PR_EMS_AB_PROTOCOL_SETTINGS ' '======================= Private Function BAccountDisabled(objOMSession) On Error Resume Next 'HTTP assumed to be enabled if property doesn't exist, or isn't found BAccountDisabled = False aProtocols = objOMSession.CurrentUser.Fields(&H81B6101F) For Each strProtocol in aProtocols If InStr(1, strProtocol, "HTTP", vbTextCompare) Then If "0" = Mid( strProtocol, 6, 1) Then BAccountDisabled = True End If Exit For End If Next Err.Clear 'Ignore errors generated here End Function '======================= ' BLogonUser ' Logs user onto Server ' ' Returns: TRUE if Successful '======================= Public Function BLogonUser(bstrMailbox) Dim objOMSession1 On Error Resume Next BLogonUser = False If (Session(bstrAuthenticated)) Then bAuthenticated = True Else bAuthenticated = False End If Err.Clear Set objOMSession1 = Server.CreateObject("MAPI.Session") If (Err.Number <> 0) Then ReportError1 L_errFailedToCreateSession_ErrorMessage Else set objRenderApp = Application( bstrRenderApp ) bstrExchServer = objRenderApp.ConfigParameter("Server") if IsEmpty(bstrExchServer) then bstrExchServer = Request.ServerVariables("SERVER_NAME") end if ' if user has typed an email address, prepend "SMTP:" iAt = InStr(1, bstrMailbox, "@", vbTextCompare) If iAt > 1 Then iDot = InStr(iAt, bstrMailbox, ".", vbTextCompare) If iDot > 1 Then If InStr(1, bstrMailbox, "SMTP:", vbTextCompare) <> 1 Then bstrMailbox = "SMTP:" & bstrMailbox End If End if End If ' Construct the OLEMSG profile from server and mailbox name If (bAuthenticated) Then bstrProfileInfo = bstrExchServer + vbLF + bstrMailbox Else bstrExchOrg = objRenderApp.ConfigParameter("Enterprise") bstrExchSite = objRenderApp.ConfigParameter("Site") bstrExchServDN = "/o=" + bstrExchOrg + "/ou=" + bstrExchSite +_ "/cn=Configuration/cn=Servers/cn=" + bstrExchServer bstrProfileInfo = bstrExchServDN + vbLF + "anon" + vbLF + "anon" End If ' Set user's locale before Logon -- do this with ObjectRenderer to avoid race condition Set objRenderObj = GetObjectRenderer Session.CodePage = objRenderObj.CodePage 'set the denali session codepage objOMSession1.SetLocaleIDs objRenderObj.LCID, objRenderObj.CodePage Set objRenderObj = Nothing ' Release Err.Clear objOMSession1.Logon "", "", False, True, 0, True, bstrProfileInfo If (Err.Number <> 0) Then ReportError1 L_errFailedConnect_ErrorMessage & bstrExchServer Else 'Load DSA Configuration Data Set objRenderApp = Application(bstrRenderApp) Set objAnonSession = Application("AMAnonSession") If objAnonSession Is Nothing Then Set objAnonSession= ReloadAnonSession If objAnonSession Is Nothing Then ReportErrorLoad L_errSorry_ErrorMessage, bstrVirtRoot & "/logon.asp" End If End If Err.Clear objRenderApp.LoadConfiguration 2, "", objAnonSession If Err <> 0 Then Set objAnonSession= ReloadAnonSession If objAnonSession Is Nothing Then ReportErrorLoad L_errSorry_ErrorMessage, bstrVirtRoot & "/logon.asp" End If Err.Clear objRenderApp.LoadConfiguration 2, "", objAnonSession If Err <> 0 Then ReportErrorLoad L_errSorry_ErrorMessage, bstrVirtRoot & "/logon.asp" End if End If If objRenderApp.ConfigParameter("HTTP Enabled") = True Then If (bAuthenticated) Then If (BAccountDisabled(objOMSession1)) Then objOMSession1.Logoff Set objOMSession1 = Nothing ReportError1 L_errHTTPDisabled_ErrorMessage Else Err.Clear Set objInbox = objOMSession1.Inbox If (Err.Number <> 0) Then objOMSession1.Logoff Set objOMSession1 = Nothing Session.Abandon Response.Redirect bstrVirtRoot & "/errinbox.asp" End If iTimeout = objRenderApp.ConfigParameter("AuthenticatedSessionTimeout") If iTimeout = 0 Then ITimeout = 60 'minutes End If Session.Timeout = iTimeout End If Session("SRRequired") = false Else If objRenderApp.ConfigParameter("Anonymous Access") = True Or _ objRenderApp.ConfigParameter("Publish GAL") = True Then iTimeout = objRenderApp.ConfigParameter("AnonymousSessionTimeout") If iTimeout = 0 Then ITimeout = 20 'minutes End If Session.Timeout = iTimeout Session("SRRequired") = objRenderApp.ConfigParameter("EnableSelfRegistration") Else objOMSession1.Logoff Set objOMSession1 = Nothing ReportError1 L_errPageDisabled_ErrorMessage End If End If 'bAuthenticated Else objOMSession1.Logoff Set objOMSession1 = Nothing ReportError1 L_errSorry_ErrorMessage End If 'load DSA config BLogonUser = True Session("hImp") = objRenderApp.ImpID Set Session(bstrOMSession) = objOMSession1 SetPageDefaults End If 'Err <> 0 End If 'Err <> 0 End Function %>