|
|
<%@ Language=VBScript %><% Option Explicit %><%dim szEmail, szServerEmail, szServerDomain, szOrigURL, szReasondim fBadEmail, fBadCheck, fAgreeCheck, fBadReason, fLimited
dim objConn, objCmd, dwResult
Response.Buffer=false Response.CacheControl="no-cache" Response.AddHeader "Pragma", "no-cache" Response.Expires=-1
%>
<!-- #include file="util.asp"--><!-- #include file="AccessUtil.asp"--><!-- #include file="MailUtil.asp"-->
<%
Sub AddAuthenticationLevel(szEmail, szDomain, wAccessLevel) dim objConn, objRec, szSQL, dwUserID, dwUserAccessLevelID dim objCmd, res, dwResult
dwUserID = 0 'Response.Write("Connection: " + szConnectionAuthorization + "<BR>") 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 "<html><body>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 "<html><body>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 "<html><body>" Response.Write "Access to this website has been denied. If you have questions concerning this, please E-mail " Response.Write "<a href='mailto:dwappr'>dwappr</a>." Response.EndEnd 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
loopEnd Sub
Sub DoApproval Response.Write "<html><head><title>Website Access Request</title></head><body>" 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.<p>If it has been more than 24-hours and you have not heard from us, please E-mail " Response.Write "<a href='mailto:dwappr'>dwappr</a>." 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("[email protected]", szTo, "Request for Watson Access", szBody, 15) then Response.Write "<html><body>" Response.Write "An error has occured while processing your request. Please E-mail " Response.Write "<a href='mailto:dwappr'>dwappr</a>." Response.End
end if
Response.Write "<html><head><title>Website Access Request</title></head><body>" Response.Write "Your request for website access has been submitted and you will receive an E-mail when it is approved.<p>If you don't hear from us within 24-hours, please E-mail " Response.Write "<a href='mailto:dwappr'>dwappr</a>." 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 "<BR> qyer: " & Request.QueryString //Response.Write "<BR> queyrstring: " & Request.QueryString( "OrigForm" ) //Response.Write ("<BR><BR>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
%>
<HTML><HEAD><TITLE>OCA Debug Portal Website Access</TITLE>
<link rel="stylesheet" type="text/css" href="CallTree.css"/><script language="javascript">function checkInput(){ if (document.all.item("txtReason").value.length <= 255) Authentication_Form.submit(); else { alert("The text in your reason is too long. Please limit your reason to 255 characters."); }}function checkReasonLength(inObj){ if (inObj.value.length <= 255) document.all.item("idReasonLength").style.display = "none"; else document.all.item("idReasonLength").style.display = "";}
</script></HEAD><BODY bgcolor=#eeeeee>
<form name="Authentication_Form" href="Authentication.asp" method=post<% if fLimited then %> onSubmit="checkInput();return(false)"
<% end if %>><input type=hidden name="Authentication" value="seen"><input type=hidden name="Orig" value="<% =Server.HTMLEncode(szOrigURL) %>"><h1><font face="Verdana" style="font-size: 16pt">Private Customer Data</font></h1><P align=left><B><FONT color=red face="Arial">Before entering this website, you must read and understand the<a href="http://watson.microsoft.com/dw/1033/dcp.asp">data collection policy</a></FONT></B></P><H2><font style="font-size: 14pt; font-style: italic" face="Verdana">Summary</font></H2><P><font face="Tahoma" size="2">The purpose of the Online Crash Analyses error reporting is to collect data and use it to improve Microsoft products. You cannot use OCA data for purposes other than finding and fixing bugs. </font><ul> <LI><font face="Tahoma" size="2">If you discover information that identifies a customer, you may not contact that customer. (Except Microsoft employees and users who have explicitly agreed to be contacted.) </font> <LI><font face="Tahoma" size="2">If you want to work with an outside company to fix a problem you must talk to the <A href="mailto:blueteam">OCA</A> team first.</font></LI></ul><P><font face="Tahoma" size="2">Please understand that by accessing this data you are bound to the <a href="http://handbook/default.asp?contentpage=/f/guidelines13.asp">NDA</a> that you signed.</font></P>
<% if fLimited then %>
<H2><font style="font-size: 14pt; font-style: italic" face="Verdana">Request Access</font></H2><p><font face="Tahoma" size="2">Please briefly describe why you need access to data on this website. You will be contacted by email when your request is approved.</font></P><p style="margin-bottom: 0"><font face="Tahoma" size="2">I need to access Watson because:</font></p><textarea rows="3" name="txtReason" cols="47" onafterupdate="checkReasonLength(this)" onchange="checkReasonLength(this)" onkeyup="checkReasonLength(this)"><% =szReason %></textarea><span id="idReasonLength" style="display:none"><font color=red><-- The text in your reason is too long. Please limit your reason to 255 characters.</font></span><% if fBadReason then Response.Write "<font color=red><-- You need to specify a reason before submitting this request.</font>" end if%></p>
<% end if %>
<P><font face="Tahoma"><font size="3"><INPUT type=checkbox name=chkAgree value="ON" <% if fAgreeCheck then %>checked<%end if %>></font><font size="2"> I have read and understand the <A href="http://watson.microsoft.com/dw/1033/dcp.asp">data collection policy</A>.</font></font><% if fBadCheck then Response.Write "<font color=red><-- You need to read and understand the data collection policy.</font>" end if%>
</P>
<P><font face="Tahoma"><font size="2">Email alias: </font><font size="3"> <INPUT name=txtEmail size="20" value="<% =szEmail %>"></font></font><% if fBadEmail then Response.Write "<font color=red><-- Incorrect E-mail alias. For example, if your E-mail is [email protected], enter just <b><i>johndoe</i></b>.</font>" end if%></P><font face="Arial"><INPUT type=submit value=Submit></font> </form>
<font face="Tahoma" size="2">If you encounter problems when using this web page, please E-mail <a href="mailto:[email protected]">[email protected]</a>.</font>
</BODY></HTML>
|
