<%@ Language=VBScript %>
<% Option Explicit %>
<%
dim szEmail, szServerEmail, szServerDomain, szOrigURL, szReason
dim fBadEmail, fBadCheck, fAgreeCheck, fBadReason, fLimited
dim objConn, objCmd, dwResult
Response.Buffer=false
Response.CacheControl="no-cache"
Response.AddHeader "Pragma", "no-cache"
Response.Expires=-1
%>
<%
Sub AddAuthenticationLevel(szEmail, szDomain, wAccessLevel)
dim objConn, objRec, szSQL, dwUserID, dwUserAccessLevelID
dim objCmd, res, dwResult
dwUserID = 0
'Response.Write("Connection: " + szConnectionAuthorization + " ")
set objConn = Server.CreateObject("ADODB.CONNECTION")
'objConn.Open szConnectionAuthorization, OCA_RW_UID, OCA_RW_PWD
objConn.Open szConnectionAuthorization
set objCmd = Server.CreateObject("ADODB.COMMAND")
objCmd.ActiveConnection = objConn
objCmd.CommandType = &H0004
objCmd.CommandText = "OcaAddUserAndLevel"
objCmd.Parameters.Append objCmd.CreateParameter ("RETURN_VALUE", 3, &H0004)
objCmd.Parameters.Append objCmd.CreateParameter ("@User",200,&H0001,50,szEmail)
objCmd.Parameters.Append objCmd.CreateParameter ("@Domain",200,&H0001,50,szDomain)
objCmd.Parameters.Append objCmd.CreateParameter ("@CurrTime",200,&H0001,50,CStr(Now()))
objCmd.Parameters.Append objCmd.CreateParameter ("@Level",3,&H0001,,wAccessLevel)
'Response.Write("User: " & szEmail & " domain: " & szDomain & " access: " & wAccessLevel )
objCmd.Execute
dwResult = CLng(objCmd.Parameters("RETURN_VALUE"))
set objCmd = nothing
objConn.Close
set objConn = nothing
if dwResult = 0 then
Response.Write "Error #1 validating user information.: " & dwResult
Response.End
end if
End Sub
Function AddUserForApproval(ApprovalTypeID, szEmail, szDomain, szReason)
dim objConn, objRec, szSQL, dwUserID, dwUserAccessLevelID
dim objCmd, res, dwResult
set objConn = Server.CreateObject("ADODB.CONNECTION")
'objConn.Open szConnectionAuthorization, OCA_RW_UID, OCA_RW_PWD
objConn.Open szConnectionAuthorization
set objCmd = Server.CreateObject("ADODB.COMMAND")
objCmd.ActiveConnection = objConn
objCmd.CommandType = &H0004
objCmd.CommandText = "OcaAddUserForApproval"
objCmd.Parameters.Append objCmd.CreateParameter ("RETURN_VALUE", 3, &H0004)
objCmd.Parameters.Append objCmd.CreateParameter ("@ApprovalType",3,&H0001,,ApprovalTypeID)
objCmd.Parameters.Append objCmd.CreateParameter ("@User",200,&H0001,50,szEmail)
objCmd.Parameters.Append objCmd.CreateParameter ("@Domain",200,&H0001,50,szDomain)
objCmd.Parameters.Append objCmd.CreateParameter ("@Reason",200,&H0001,255,szReason)
objCmd.Execute
dwResult = CLng(objCmd.Parameters("RETURN_VALUE"))
set objCmd = nothing
objConn.Close
set objConn = nothing
if dwResult = -1 then
Response.Write "Error #2 validating user information."
Response.End
end if
AddUserForApproval = dwResult
End Function
Function FLimitedUser(szEmail, szDomain)
Dim szEmailT, szDomainT
FLimitedUser=False
exit function
szEmailT = CStr(szEmail)
szDomainT = CStr(szDomain)
if Len(szEmailT) = 0 or Len(szDomainT) = 0 then
FLimitedUser = False
exit function
end if
if (Len(szEmailT) >=3) then
if Mid(szEmailT, 2, 1) = "-" then
FLimitedUser = True
Exit Function
end if
end if
if StrComp(szDomainT, "redmond", vbTextCompare) <> 0 And StrComp(szDomainT, "ntdev", vbTextCompare) <> 0 And _
StrComp(szDomainT, "northamerica", vbTextCompare) <> 0 then
FLimitedUser = True
exit function
end if
FLimitedUser = False
End Function
Sub DoRedirect
if (szOrigURL <> "") then
Response.Redirect szOrigURL
end if
Response.Redirect "../dbgportalv2.asp"
Response.End
End Sub
Sub DoNoAccess
Response.Write ""
Response.Write "Access to this website has been denied. If you have questions concerning this, please E-mail "
Response.Write "dwappr."
Response.End
End Sub
Function EmailListFromAccessLevelID(AccessLevelID)
dim objConn, objRec, szSQL, dwUserID, dwUserAccessLevelID
dim fFirst, szEmail, cCount
fFirst = True
set objConn = Server.CreateObject("ADODB.CONNECTION")
set objRec = Server.CreateObject("ADODB.RECORDSET")
'objConn.Open szConnectionAuthorization, OCA_RO_UID, OCA_RO_PWD
objConn.Open szConnectionAuthorization
objConn.CommandTimeout = 600
szSQL = "SELECT UserAlias FROM OcaAuthorizedUsers INNER JOIN OcaUserAccessLevels ON OcaAuthorizedUsers.UserID = OcaUserAccessLevels.UserID WHERE AccessLevelID = " & AccessLevelID
set objRec = objConn.Execute (szSQL)
szEmail = ""
cCount = 0
if not objRec.EOF then
do until objRec.EOF
cCount = cCount + 1
if cCount > 10 then
Response.Write "Mail overflow error!"
Response.End
end if
if Not fFirst then
szEmail = szEmail & ","
else
fFirst = False
end if
szEmail = szEmail & objRec("UserAlias") & "@microsoft.com"
objRec.MoveNext
Loop
end if
objRec.Close
set objRec = nothing
objConn.Close
set objConn = nothing
EmailListFromAccessLevelID = szEmail
End Function
Sub FindReplace(szString, szFind, szReplace)
dim iPos, cchFind, szResult, cchString
cchFind = Len(szFind)
Do While (true)
iPos = Instr(szString, szFind)
if iPos = 0 then
exit sub
end if
cchString = Len(szString)
if iPos = 1 then
szResult = ""
else
szResult = Left(szString, iPos - 1)
end if
szResult = szResult & szReplace
if (iPos + cchFind - 1) <> cchString then
szResult = szResult & Right(szString, 1+(cchString - (iPos + cchFind)))
end if
szString = szResult
loop
End Sub
Sub DoApproval
Response.Write "Website Access Request"
Response.Write "Your request for website access was previously submitted, but has not been approved yet. You will receive an E-mail when it is approved.
If it has been more than 24-hours and you have not heard from us, please E-mail "
Response.Write "dwappr."
Response.End
End Sub
Sub SendApprovalMail(dwUserID, AccessLevelID, szEmail, szDomain, szReason)
dim szBody, szTo
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f, szFilename
szFilename = Server.MapPath("\") & "\ApproverEmail.htm"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(szFilename, ForReading,False,0)
szBody = f.ReadAll
f.Close
set f=nothing
set fs = nothing
FindReplace szBody, "%domainalias%", szDomain & "\" & szEmail
FindReplace szBody, "%approveurl%", "http://watson/UserLevels.asp?UserID=" & dwUserID
FindReplace szBody, "%requestuser%", szEmail
FindReplace szBody, "%reason%", szReason
szTo = EmailListFromAccessLevelID(AccessLevelID)
if Not FSendMail("dwappr@microsoft.com", szTo, "Request for Watson Access", szBody, 15) then
Response.Write "
"
Response.Write "An error has occured while processing your request. Please E-mail "
Response.Write "dwappr."
Response.End
end if
Response.Write "Website Access Request"
Response.Write "Your request for website access has been submitted and you will receive an E-mail when it is approved.
If you don't hear from us within 24-hours, please E-mail "
Response.Write "dwappr."
Response.End
End Sub
Sub ProcessApproval(szEmail, szDomain, szReason)
dim dwUserID
dim szReasonLimited
szReasonLimited = szReason
if Len(szReasonLimited) > 255 then
szReasonLimited = Left(szReasonLimited, 255)
end if
dwUserID = AddUserForApproval(constApprovalTypeWebsiteAccess, szEmail, szDomain, szReasonLimited)
'SendApprovalMail dwUserID, constAccessApproveNonStd, szEmail, szDomain, szReasonLimited
End Sub
szEmail = ""
szReason = ""
fBadReason = False
fAgreeCheck = False
szOrigURL = CStr(Request("Orig"))
if CStr(Request.QueryString ) <> "" then
szOrigURL = Request.QueryString
end if
//Response.Write " qyer: " & Request.QueryString
//Response.Write " queyrstring: " & Request.QueryString( "OrigForm" )
//Response.Write ("
SZOrigurl: " & szOrigURL )
EmailDomainFromLogon szServerEmail, szServerDomain
fLimited = FLimitedUser(szServerEmail, szServerDomain)
set objConn = Server.CreateObject("ADODB.CONNECTION")
'objConn.Open szConnectionAuthorization, OCA_RO_UID, OCA_RO_PWD
'objConn.Open "Driver=SQL Server;Server=TKOffDWSql02;DATABASE=Authorization;uid=ocasqlrw;pwd=FT126USW"
objConn.Open szConnectionAuthorization
set objCmd = Server.CreateObject("ADODB.COMMAND")
objCmd.ActiveConnection = objConn
objCmd.CommandType = &H0004
objCmd.CommandText = "OcaCheckUserAccessApprovals"
objCmd.Parameters.Append objCmd.CreateParameter ("RETURN_VALUE", 3, &H0004)
objCmd.Parameters.Append objCmd.CreateParameter ("@User",200,&H0001,50,szServerEmail)
objCmd.Parameters.Append objCmd.CreateParameter ("@Domain",200,&H0001,50,szServerDomain)
objCmd.Parameters.Append objCmd.CreateParameter ("@Level",3,&H0001,,constAccessAuthorized)
objCmd.Parameters.Append objCmd.CreateParameter ("@ApprovalTypeID",3,&H0001,,constApprovalTypeWebsiteAccess )
objCmd.Execute
dwResult = CLng(objCmd.Parameters("RETURN_VALUE"))
set objCmd = nothing
objConn.Close
set objConn = nothing
if dwResult = 1 then
Session("Authenticated") = "Yes"
DoRedirect
end if
if dwResult = 2 then
DoNoAccess
end if
if dwResult = 3 then
DoApproval
end if
if (Request("Authentication") = "seen") then
if Request.Form("chkAgree") <> "ON" then
fBadCheck = True
else
fAgreeCheck = True
end if
szEmail = CStr(Request.Form("txtEmail"))
if StrComp(szServerEmail, szEmail, vbTextCompare) <> 0 or szServerEmail = "" then
fBadEmail = True
end if
if fLimited then
szReason = CStr(Request.Form("txtReason"))
if Len(szReason) = 0 then
fBadReason = True
end if
end if
if Not fBadEmail and Not fBadCheck and not fBadReason then
if Not fLimited then
Session("Authenticated") = "Yes"
AddAuthenticationLevel szServerEmail, szServerDomain, constAccessAuthorized
DoRedirect
else
AddAuthenticationLevel szServerEmail, szServerDomain, constAccessAuthorized
ProcessApproval szServerEmail, szServerDomain, szReason
end if
end if
end if
%>
OCA Debug Portal Website Access
If you encounter problems when using this web page, please E-mail SOlson@Microsoft.com.