总觉得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 ＭＳ Ｐゴシック; color:FF0000}
a:visited {font:8pt/11pt ＭＳ Ｐゴシック; 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(/%3A/g, ':').replace(/%3B/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
%>
|