<%@ Language=VBScript %> <% Option Explicit Response.Buffer = true %> <!-- #include file="AuthorizedUtil.asp"--> <!-- #include file="MailUtil.asp"--> <% dim szSQL dim rgLevelID(), rgLevelDesc(), cElement, rgUserLevelDesc() dim objConn, objRec, objCmd dim UserID, AccessLevelID dim fFirst, dwUserID, iElement dim szReason, szApproverAlias, szApproverDomain, szDateApproved dim szHasApprovals, szSortType dim ApprovalTypeID Function GetUserIDFromLogon() dim szEmail, szDomain dim objConnT, objRecT, objCmdT dim dwResult EmailDomainFromLogon szEmail, szDomain set objConnT = Server.CreateObject("ADODB.CONNECTION") 'objConnT.Open szConnectionAuthorization, OCA_RO_UID, OCA_RO_PWD objConnT.Open szConnectionAuthorization set objCmdT = Server.CreateObject("ADODB.COMMAND") objCmdT.ActiveConnection = objConnT objCmdT.CommandType = &H0004 objCmdT.CommandText = "OcaGetUserID" objCmdT.Parameters.Append objCmdT.CreateParameter ("RETURN_VALUE", 3, &H0004) objCmdT.Parameters.Append objCmdT.CreateParameter ("@User",200,&H0001,50,szEmail) objCmdT.Parameters.Append objCmdT.CreateParameter ("@Domain",200,&H0001,50,szDomain) objCmdT.Execute dwResult = CLng(objCmdT.Parameters("RETURN_VALUE")) set objCmdT = nothing objConnT.Close set objConnT = nothing GetUserIDFromLogon = dwResult End Function Function ArrayPosFromAccessLevelID(AccessLevelID, rgArray, cArray) dim iPos for iPos = 0 to cArray - 1 if rgArray(iPos) = AccessLevelID then ArrayPosFromAccessLevelID = iPos exit function end if next ArrayPosFromAccessLevelID = -1 End Function Sub ProcessApprovals(objConnIn, UserID) dim objRecApprovals dim szSQL dim fFirstRec, fFirstOverall set objRecApprovals = Server.CreateObject("ADODB.RECORDSET") szSQL = "select * from OcaApprovalList WHERE UserID = " & UserID & " ORDER BY dateapproved DESC, approvaltypeid ASC" set objRecApprovals = objConn.Execute (szSQL) if objRecApprovals.EOF then objRecApprovals.Close set objRecApprovals = nothing exit sub end if fFirstRec = True fFirstOverall = True do until objRecApprovals.EOF if IsNull(objRecApprovals("DateApproved")) then if FIsAuthenticated(CLng(objRecApprovals("ApproverAccessLevelID"))) or FIsAuthenticated(constAccessAdministrator) then if fFirstOverall then Response.Write "<br><br>" fFirstOverall = False end if if not fFirstRec then Response.Write "<hr>" end if %> <span style="color:red"><b><% =objRecApprovals("ApprovalDescription") %> request</b></span><br> <table><tr><td><b>Reason:</b></td><td><% =objRecApprovals("Reason") %></td></tr> <tr><td colspan=2> <a href="UserLevels.asp?UserID=<% =UserID %>&ApprovalTypeID=<% =objRecApprovals("ApprovalTypeID") %>&cmd=GrantAccess">Grant Access</a> (User will be notified via E-mail.) </td></tr> </table> <% fFirstRec = false end if else if fFirstOverall then Response.Write "<br><br>" fFirstOverall = False end if %> <i><% =objRecApprovals("ApprovalDescription") %> approved on <% =objRecApprovals("DateApproved") %> by <% =objRecApprovals("ApproverDomain") %>\<% =objRecApprovals("ApproverAlias") %></i><br> <% fFirstRec = false end if objRecApprovals.MoveNext Loop objRecApprovals.Close set objRecApprovals = nothing End Sub Sub DumpUnusedLevels(objConnIn, iElement, cElement, UserID) dim fFirstDesc fFirstDesc = True if szHasApprovals = "Yes" then ProcessApprovals objConnIn, UserID end if Response.Write "</td><td><td class=toprightleft>" for iElement = 0 to cElement - 1 if rgUserLevelDesc(iElement) = "" then if fFirstDesc then Response.Write "<form action='UserLevels.asp' method=get style='margin:0pt'>" Response.Write "<input type=hidden name=cmd value=Add>" Response.Write "<input type=hidden name=UserID value=" & UserID & ">" Response.Write "<select name=AccessLevelID style='width:150px'>" fFirstDesc = false end if Response.Write "<option value=" & rgLevelID(iElement) & ">" & rgLevelDesc(iElement) & "</option>" end if next if not fFirstDesc then Response.Write "</select><input type=submit name=start value='Add'></form>" end if Response.Write "</td></tr>" End Sub %> <% dim szLogon, fValid, cUsers, UserIDParam dim fFirstDesc szSortType = CStr(Request("SortType")) if Len(CStr(Request("UserID"))) > 0 then UserIDParam = CLng(Request("UserID")) else UserIDParam = -1 end if cUsers = 0 szLogon = Request.ServerVariables("LOGON_USER") fValid = FIsAuthenticated(constAccessAdministrator) if szLogon = "REDMOND\solson" or szLogon = "REDMOND\derekmo" or szLogon = "REDMOND\erikt" or szLogon = "REDMOND\gabea" then fValid = True end if if Not fValid then Response.Write "You are not authorized to view this page . . .sorry<BR>" Response.End end if %> <html> <head><title>User Level Maintenance</title> <style> td { font-family: Verdana, sans-serif; color:black; font-size:10pt; padding-top:1px; padding-left:1px; padding-right:1px; font-size:8pt; } input { font-family: verdana; font-size: 8pt; margin: 0pt } select { font-family: verdana; font-size: 8pt; margin: 0pt } th { background-color:CFD5E5; font-size:11pt; padding-top:1px; padding-left:1px; padding-right:1px; } .no1 { font-family: Verdana, sans-serif; color:black; } .top { border-top: .5pt solid windowtext; } .left { border-left: .5pt solid windowtext; } .topleft { border-top: .5pt solid windowtext; border-left: .5pt solid windowtext; } .topright { border-top: .5pt solid windowtext; border-right: .5pt solid windowtext; } .toprightleft { border-top: .5pt solid windowtext; border-left: .5pt solid windowtext; border-right: .5pt solid windowtext; } .box { border-top: .5pt solid windowtext; border-bottom: .5pt solid windowtext; border-left: .5pt solid windowtext; border-right: .5pt solid windowtext; } </style> </head> <body style="font-family:Verdana, sans-serif;color:black; font-size:10pt"> <% set objConn = Server.CreateObject("ADODB.CONNECTION") set objRec = Server.CreateObject("ADODB.RECORDSET") '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 objConn.CommandTimeout = 600 szSQL = "select * from OcaAccessLevels" set objRec = objConn.Execute (szSQL) cElement = 0 if not objRec.EOF then do until objRec.EOF cElement = cElement + 1 Redim Preserve rgLevelID(cElement) Redim Preserve rgLevelDesc(cElement) rgLevelID(cElement - 1) = objRec("AccessLevelID") rgLevelDesc(cElement - 1) = objRec("AccessDescription") objRec.MoveNext Loop end if objRec.Close set objRec = nothing objConn.Close set objConn = nothing Redim rgUserLevelDesc(cElement) if Request("cmd") = "Add" or Request("cmd") = "Remove" then UserID = -1 AccessLevelID = -1 if Request("UserID") <> "" then UserID = CLng(Request("UserID")) end if if Request("AccessLevelID") <> "" then AccessLevelID = CLng(Request("AccessLevelID")) end if if UserID <> -1 and AccessLevelID <> -1 then 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 if Request("cmd") = "Remove" then objCmd.CommandText = "OcaRemoveUserLevel" else objCmd.CommandText = "OcaAddUserLevel" end if objCmd.Parameters.Append objCmd.CreateParameter ("@UserID",3,&H0001,,UserID) objCmd.Parameters.Append objCmd.CreateParameter ("@Level",3,&H0001,,AccessLevelID) objCmd.Execute set objCmd = nothing objConn.Close set objConn = nothing end if Response.Redirect "UserLevels.asp" end if if Request("cmd") = "GrantAccess" then UserID = -1 ApprovalTypeID = -1 if Request("UserID") <> "" then UserID = CLng(Request("UserID")) end if if Request("ApprovalTypeID") <> "" then ApprovalTypeID = CLng(Request("ApprovalTypeID")) end if if UserID <> -1 and ApprovalTypeID <> -1 then dim szServerEmail, szServerDomain, szToAlias, szBody dim ApproverUserID ApproverUserID = GetUserIDFromLogon() EmailDomainFromLogon szServerEmail, szServerDomain 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 = "OcaApproveUser" objCmd.Parameters.Append objCmd.CreateParameter ("@UserID",3,&H0001,,UserID) objCmd.Parameters.Append objCmd.CreateParameter ("@ApprovalTypeID",3,&H0001,,ApprovalTypeID) objCmd.Parameters.Append objCmd.CreateParameter ("@ApproverUserID",3,&H0001,,ApproverUserID) objCmd.Parameters.Append objCmd.CreateParameter ("@DateApproved",200,&H0001,50,CStr(Now())) objCmd.Execute set objCmd = nothing set objRec = Server.CreateObject("ADODB.RECORDSET") szSQL = "SELECT UserAlias FROM OcaAuthorizedUsers WHERE UserID = " & UserID set objRec = objConn.Execute (szSQL) if not objRec.EOF then szToAlias = CStr(objRec("UserAlias")) & "@microsoft.com" else szToAlias = "" end if objRec.Close set objRec = nothing objConn.Close set objConn = nothing if szToAlias <> "" then Const ForReading = 1, ForWriting = 2, ForAppending = 3 Dim fs, f, szFilename 'szFilename = Server.MapPath("\") & "\privacy\RequesterEmail.htm" 'Set fs = CreateObject("Scripting.FileSystemObject") 'Set f = fs.OpenTextFile(szFilename, ForReading,False,0) 'szBody = f.ReadAll szBody="" 'f.Close 'set f=nothing 'set fs = nothing 'if Not FSendMail("dwappr@microsoft.com", szToAlias, "OCA Debug Portal access granted", szBody, 10) then 'Response.Write "<html><body>" 'Response.Write "An error has occured while processing your request." 'Response.End 'end if end if end if Response.Redirect "UserLevels.asp" end if %> <center><form method=get action="UserLevels.asp"><b>Sort users by:</b> <input type=radio name="SortType" value="ByUserAlias" <% if szSortType<>"ByUserID" and szSortType<>"ByDateSigned" then %> checked <% end if %> >User alias <input type=radio name="SortType" value="ByUserID" <% if szSortType="ByUserID" then %> checked <% end if %> >First site access date <input type=radio name="SortType" value="ByDateSigned" <% if szSortType="ByDateSigned" then %> checked <% end if %> >Date signed DCP <input type=submit name="SortText" value="Change Sort"> </form> </center> <table border=0 cellpadding=0 cellspacing=0 style="font-family:Verdana"> <tr > <th class=topleft>Logon Domain/Alias<th class=topleft>Date DCP Signed<th class=toprightleft width=50%>User Level<td width=25> <th class=toprightleft>Actions <% set objConn = Server.CreateObject("ADODB.CONNECTION") set objRec = Server.CreateObject("ADODB.RECORDSET") '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 szSQL = "SELECT * FROM OcaUserList " if UserIDParam <> -1 then szSQL = szSQL & " WHERE UserID = " & UserIDParam end if if szSortType="ByUserID" then szSQL = szSQL & " ORDER BY NeedsApproval DESC, UserID ASC, AccessLevelID ASC" elseif szSortType="ByDateSigned" then szSQL = szSQL & " ORDER BY NeedsApproval DESC, DateSignedDCP ASC, AccessLevelID ASC" else szSQL = szSQL & " ORDER BY NeedsApproval DESC, UserAlias ASC, AccessLevelID ASC" end if set objRec = objConn.Execute (szSQL) if not objRec.EOF then fFirst = True do until objRec.EOF if Not fFirst then if CLng(objRec("UserID")) <> dwUserID then DumpUnusedLevels objConn,iElement, cElement, dwUserID fFirst = True else Response.Write ", " & objRec("AccessDescription") & " (<a href='UserLevels.asp?cmd=Remove&UserID=" & objRec("UserID") & "&AccessLevelID=" & objRec("AccessLevelID") & "'>Remove</a>)" rgUserLevelDesc(ArrayPosFromAccessLevelID(CLng(objRec("AccessLevelID")), rgLevelID, cElement)) = "Seen" end if end if if fFirst then for iElement = 0 to cElement - 1 rgUserLevelDesc(iElement) = "" next cUsers = cUsers + 1 rgUserLevelDesc(ArrayPosFromAccessLevelID(CLng(objRec("AccessLevelID")), rgLevelID, cElement)) = "Seen" Response.Write "<tr>" Response.Write "<td class=topleft>" & objRec("UserDomain") & "\" & objRec("UserAlias") & "</td>" Response.Write "<td class=topleft>" & objRec("DateSignedDCP") & "</td>" Response.Write "<td class=toprightleft>" & objRec("AccessDescription") & " (<a href='UserLevels.asp?cmd=Remove&UserID=" & objRec("UserID") & "&AccessLevelID=" & objRec("AccessLevelID") & "'>Remove</a>)" dwUserID = CLng(objRec("UserID")) szHasApprovals = objRec("HasApprovals") fFirst = False end if objRec.MoveNext Loop DumpUnusedLevels objConn,iElement, cElement, dwUserID Response.Write "<tr><td colspan=3 class=top> </td><td> </td><td class=top> </td></tr>" end if objRec.Close set objRec = nothing objConn.Close set objConn = nothing %> </table> <br> <% =cUsers %> users <p><b>Notes:</b></p> Adding the "No Access" level will prevent users from using the website. It takes precedence over all other levels. They will be denied access and directed to E-mail dwcore with questions.<br> Removing the "Authorized" level will cause the user to see the authorization sign-in page again.