总觉得IIS500错误的页面比较难看,而且提示信息不全。所以自己修改一下。可能有一些垃圾代码(主要在变量定义)没有删除。 主要修正的看点在于,传到出错页面,得所有接收参数遍历显示出来。比较方便发现问题。
另外,可以将出错的信息以写入数据库中(flgRecord ),这样对生产环境来讲,能够及时发现并记录一些程序BUG,对开发环境来讲,能够通过对这些数据的分析,让程序员知道自己经常的错误点,提高编码效率。
<%@ language="VBScript" %><% Option Explicit
Const lngMaxFormBytes = 200
Dim objASPError, blnErrorWritten, strServername, strServerIP, strRemoteIP,flgRecord Dim strMethod, lngPos, datNow, strQueryString, strURL,l_loop2,l_loopi,l_loop3 Dim objDicPost,objDicGet,l_loop Dim arrDicPostKey,arrGetKey Dim arrPostItem,arrGetItem Dim l_intStyleL,l_intStyleR Dim g_arrInsertDB(7) Randomize flgRecord = Flase g_arrInsertDB(0) = Replace(Replace(Replace("A" & CStr(Replace(CStr(SESSION.SESSIONID()) & CStr(Now()) & CStr(Rnd()) & CStr(Rnd())," ","")),"E",""),"-",""),":","") g_arrInsertDB(0) = Replace(g_arrInsertDB(0),".","") g_arrInsertDB(0) = """" & Replace(g_arrInsertDB(0),".","") & """" g_arrInsertDB(1) = """" & Now() & """" Set objDicPost = Server.CreateObject("Scripting.Dictionary") For Each l_loop2 In Request.Form objDicPost.Add l_loop2,Request.Form(l_loop2) Next arrDicPostKey = objDicPost.Keys arrPostItem = objDicPost.Items
Set objDicGet = Server.CreateObject("Scripting.Dictionary") For Each l_loop3 In Request.QueryString objDicGet.Add l_loop3,Request.QueryString(l_loop3) Next arrGetKey = objDicGet.Keys arrGetItem = objDicGet.Items
If Response.Buffer Then Response.Clear Response.Status = "500 Internal Server Error" Response.ContentType = "text/html" Response.Expires = 0 End If
Set objASPError = Server.GetLastError Dim bakCodepage on error resume next bakCodepage = Session.Codepage Session.Codepage = 1252 on error goto 0
%><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html dir=ltr>
<head><style>a:link {font:8pt/11pt MS Pゴシック; color:FF0000}a:visited {font:8pt/11pt MS Pゴシック; color:#4e4e4e}</style>
<META NAME="ROBOTS" CONTENT="NOINDEX">
<title>程序出現錯誤</title>
<META HTTP-EQUIV="Content-Type" Content="text-html; charset=shift_jis"></head>
<script> function Homepage(){<!--// in real bits, urls get returned to our script like this:// res://shdocvw.dll/http_404.htm#http://www.DocURL.com/bar.htm
//For testing use DocURL = "res://shdocvw.dll/http_404.htm#https://www.microsoft.com/bar.htm" DocURL=document.URL; //this is where the http or https will be, as found by searching for :// but skipping the res:// protocolIndex=DocURL.indexOf("://",4); //this finds the ending slash for the domain server serverIndex=DocURL.indexOf("/",protocolIndex + 3);
//for the href, we need a valid URL to the domain. We search for the # symbol to find the begining //of the true URL, and add 1 to skip it - this is the BeginURL value. We use serverIndex as the end marker. //urlresult=DocURL.substring(protocolIndex - 4,serverIndex); BeginURL=DocURL.indexOf("#",1) + 1; urlresult=DocURL.substring(BeginURL,serverIndex); //for display, we need to skip after http://, and go to the next slash displayresult=DocURL.substring(protocolIndex + 3 ,serverIndex); InsertElementAnchor(urlresult, displayresult);}
function HtmlEncode(text){ return text.replace(/&/g, '&').replace(/'/g, '"').replace(/</g, '<').replace(/>/g, '>');}
function TagAttrib(name, value){ return ' '+name+'="'+HtmlEncode(value)+'"';}
function PrintTag(tagName, needCloseTag, attrib, inner){ document.write( '<' + tagName + attrib + '>' + HtmlEncode(inner) ); if (needCloseTag) document.write( '</' + tagName +'>' );}
function URI(href){ IEVer = window.navigator.appVersion; IEVer = IEVer.substr( IEVer.indexOf('MSIE') + 5, 3 );
return (IEVer.charAt(1)=='.' && IEVer >= '5.5') ? encodeURI(href) : escape(href).replace(/:/g, ':').replace(/;/g, ';');}
function InsertElementAnchor(href, text){ PrintTag('A', true, TagAttrib('HREF', URI(href)), text);}
//--></script>
<body bgcolor="#DCDCDC">
<table cellpadding="0" cellspacing="0" STYLE="border:.5pt solid windowtext;width=990px;"> <tr STYLE="border:.5pt solid windowtext"> <th colspan=100 STYLE="border:.5pt solid windowtext"> 500.100 錯誤信息 </th> </tr> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 錯誤類型 <td> <td STYLE="border:.5pt solid windowtext"> <%=Server.HTMLEncode(objASPError.Category)%> <%g_arrInsertDB(2)="""" &Server.HTMLEncode(objASPError.Category)& """" %> </td> </tr> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 錯誤號 <td> <td STYLE="border:.5pt solid windowtext"> <%=Server.HTMLEncode("0x" & Hex(objASPError.Number))%> <%g_arrInsertDB(3)="""" &Server.HTMLEncode("0x" & Hex(objASPError.Number))& """" %> </td> </tr> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 錯誤號描述 <td> <td STYLE="border:.5pt solid windowtext"> <% If objASPError.ASPDescription > "" Then Response.Write Server.HTMLEncode(objASPError.ASPDescription) g_arrInsertDB(4)= """" & Server.HTMLEncode(objASPError.ASPDescription)& """" elseIf (objASPError.Description > "") Then Response.Write Server.HTMLEncode(objASPError.Description) g_arrInsertDB(4)= """" & Server.HTMLEncode(objASPError.Description) & """" end if %> </td> </tr> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 出錯文件名 <td> <td STYLE="border:.5pt solid windowtext"> <%=Server.HTMLEncode(objASPError.File)%> <%g_arrInsertDB(5)="""" & Server.HTMLEncode(objASPError.File) & """" %> </td> </tr><% blnErrorWritten = False
' Only show the Source if it is available and the request is from the same machine as IIS If objASPError.Source > "" Then strServername = LCase(Request.ServerVariables("SERVER_NAME")) strServerIP = Request.ServerVariables("LOCAL_ADDR") strRemoteIP = Request.ServerVariables("REMOTE_ADDR") If (strServername = "localhost" Or strServerIP = strRemoteIP) And objASPError.File <> "?" Then%> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 出錯位置 <td> <td STYLE="border:.5pt solid windowtext"> <% If objASPError.Line > 0 Then Response.Write "Row " & objASPError.Line If objASPError.Column > 0 Then Response.Write ",Col " & objASPError.Column %> <%g_arrInsertDB(6)= """" & objASPError.Line & "," & objASPError.Column & """"%> </td> </tr>
<% blnErrorWritten = True End If End If%> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 瀏覽器信息 <td> <td STYLE="border:.5pt solid windowtext"> <%= Server.HTMLEncode(Request.ServerVariables("HTTP_USER_AGENT")) %> <%g_arrInsertDB(7)= """" & Server.HTMLEncode(Request.ServerVariables("HTTP_USER_AGENT")) & """"%> </td> </tr> <tr> <td Width=10% STYLE="border:.5pt solid windowtext"> 提交到該葉的數據 <td> <td STYLE="border:.5pt solid windowtext"> <table width="100%" cellpadding="0" cellspacing="0" STYLE="border:none;"> <tr> <td Width="10%" STYLE="border:.5pt solid windowtext;border-top:none;border-left:none;">POST方法</td> <td STYLE="border:.5pt solid windowtext;border-top:none;border-right:none;"> <table width="100%" cellpadding="0" cellspacing="0" STYLE="border:none"> <% If objDicPost.Count <> 0 Then%> <tr> <td Width="10%" align=center STYLE="border:.5pt solid windowtext;border-top:none;border-left:none;">鍵</td> <td align=center STYLE="border:.5pt solid windowtext;border-top:none;border-right:none;">値</td> </tr> <% For l_loop2 = 0 To objDicPost.Count - 1 If l_loop2 = objDicPost.Count - 1 Then l_intStyleL = "border:.5pt solid windowtext;border-bottom:none;border-top:none;border-left:none;" l_intStyleR = "border:.5pt solid windowtext;border-bottom:none;border-top:none;border-right:none;" Else l_intStyleL = "border:.5pt solid windowtext;border-top:none;border-left:none;" l_intStyleR = "border:.5pt solid windowtext;border-top:none;border-right:none;" End If %> <tr> <td Width="10%" STYLE="<%=l_intStyleL%>text-align:center;"><%=arrDicPostKey(l_loop2)%></td> <td STYLE="<%=l_intStyleR%>" ><%=Replace(Replace(arrPostItem(l_loop2),"<","<"),">",">") %></td> </tr> <%Next Else%> <tr> <td colspan=100 style="border:none;">沒有用POST方法傳入的數據!</td> </tr> <%End If%> </table> </td> </tr> <tr> <td Width="10%" STYLE="border:.5pt solid windowtext;border-bottom:none;border-left:none;">GET方法</td> <td STYLE="border:.5pt solid windowtext;border-bottom:none;border-right:none;"> <table width="100%" cellpadding="0" cellspacing="0" STYLE="border:none"> <% If objDicPost.Count <> 0 Then%> <tr> <td Width="10%" align=center STYLE="border:.5pt solid windowtext;border-top:none;border-left:none;">鍵</td> <td align=center STYLE="border:.5pt solid windowtext;border-top:none;border-right:none;">値</td> </tr> <% For l_loop2 = 0 To objDicGet.Count - 1 If l_loop2 = objDicGet.Count - 1 Then l_intStyleL = "border:.5pt solid windowtext;border-bottom:none;border-top:none;border-left:none;" l_intStyleR = "border:.5pt solid windowtext;border-bottom:none;border-top:none;border-right:none;" Else l_intStyleL = "border:.5pt solid windowtext;border-top:none;border-left:none;" l_intStyleR = "border:.5pt solid windowtext;border-top:none;border-right:none;" End If %> <tr> <td Width="10%" STYLE="<%=l_intStyleL%>text-align:center;"><%=arrGetKey(l_loop2)%></td> <td STYLE="<%=l_intStyleR%>" ><%=Replace(Replace(arrGetItem(l_loop2),"<","<"),">",">") %></td> </tr> <% Next Else%> <tr> <td colspan=100 style="border:none;">沒有用Get方法傳入的數據!</td> </tr> <%End If%> </table> </td> </tr> </table> </td> </tr> </table></body></html><%
If flgRecord = True Then Dim conDB Set conDB = Server.CreateObject("ADODB.Connection") conDB.Open "provider=microsoft.jet.oledb.4.0;data source=D:/Record/ASPDEVELOPMENT.mdb"
'On Error Resume Next conDB.Execute "INSERT INTO ASP_D_ERROR VALUES(" & JOIN(g_arrInsertDB,",") & ")" If Err.Number = 0 Then 'Response.write " -------------------------- <<<<<<<<< DB INSERT SUCCESS >>>>>>>>> --------------------------" End If On Error GoTo 0 conDB.close Set conDB = nothing End If
%>