Hej!
Jeg har selv brugt den nederste med godt resultat.
Og så har jeg prøvet at skrue noget sammen her.
Det skal selvf. rettes til, men så tror jeg faktisk godt at det kan lade sig gøre.
Brug koden i en INCLUDE er mit umiddelbare foreslag.
<%
Const strFolderName = "logs\"
Const strFileExt = ".txt"
Dim strLogsPath, data
strLogsPath = Server.MapPath(strFolderName) &"\"
set objErr=Server.GetLastError()
data = ("ASPCode=" & objErr.ASPCode)
data = data & ("<br />")
data = data & ("ASPDescription=" & objErr.ASPDescription)
data = data & ("<br />")
data = data & ("Category=" & objErr.Category)
data = data & ("<br />")
data = data & ("Column=" & objErr.Column)
data = data & ("<br />")
data = data & ("Description=" & objErr.Description)
data = data & ("<br />")
data = data & ("File=" & objErr.File)
data = data & ("<br />")
data = data & ("Line=" & objErr.Line)
data = data & ("<br />")
data = data & ("Number=" & objErr.Number)
data = data & ("<br />")
data = data & ("Source=" & objErr.Source)
'-------------------------------------------------------------------------------
if len(objErr.ASPCode) then
Call CreateLogFile(strLogsPath,strFileExt)
Call WriteLog(strLogsPath,strFileExt,data)
end if
Function CreateLogFile(byVal strLogFolderPath, byVal strFileExt)
'generate log file name
strLogFileName = FileName(strFileExt)
'check if the file doesn't exist in the folder (if no create it)
If CheckIfFileExists(strLogFolderPath, strLogFileName) = False Then
'Declare local variables
Dim objFSO, objCreatedFile
'create an instance FileSystemObject
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'create text file
Set objCreatedFile = objFSO.CreateTextFile(strLogFolderPath & strLogFileName, True)
'close instance
objCreatedFile.Close
Set objFSO = nothing
Else
'if the log file already exists then exit function
Exit Function
End if
End Function
Function FileName(byVal strFileExt)
strYear = DatePart("YYYY",Date) 'get current year
strMonth = DatePart("M",Date) 'get current month
strDay = DatePart("D",Date) 'get current date
'if the month is one digit ex. 7 then add a '0' in front to become 07
If Len(strMonth) = 1 Then strMonth = "0"&strMonth
'if the date is one digit ex. 7 then add a '0' in front to become 07
If Len(strDay) = 1 Then strDay = "0"&strDay
'construct the filename.
FileName = strYear&strMonth&strDay&strFileExt
End Function
Function CheckIfFileExists(byVal FolderPath, byVal FileName)
CheckIfFileExists = False
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
For Each file In objFolder.files
if Lcase(file.name) = Trim(LCase(Filename)) Then
CheckIfFileExists = True
End if
Next
Set objFSO = nothing
End function
Sub WriteLog (byVal strLogFolderPath, byVal strFileExt, byVal strData)
'construct full path with the file name
strPath = strLogFolderPath & FileName(strFileExt)
'declare variables
Dim objFSO, tmpFile
'create an instance FileSystemObject
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Forappending = 8
'open file for appending
set tempFile = objFSO.OpentextFile(strPath, Forappending)
'add the data into a new line. Time() will print the current time when the data
'will be written to file
tempFile.writeline now() &": "& data
'close instance
tempFile.close
Set tempFile = nothing
Set objFSO = nothing
End Sub
%>
'Næste-------------------------------------------------------
<%@ Language=VBScript %>
<%
'----------------------------------------------------------------------------
' System Name: Error Handling
'----------------------------------------------------------------------------
' Filnavn: 500-100.asp
'----------------------------------------------------------------------------
' Beskrivelse:
' Siden håndterer 500-100 errors som sker på siden.
' Fejl bliver logged til txt-fil og evt, database.
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Dim mstrFileName
Dim mstrCustRefID
Dim ASPErr
mstrFileName = "C:\W3Sites\ditwebsite\www\log\ErrorLog.txt"
'Kundeid til reff.
mstrCustRefID = Session.SessionID & "-" & Hour(Now) & Minute(Now) & Second(Now)
Set ASPErr = Server.GetLastError
Response.Clear
LogErrorToFile
'LogErrorToDatabase
Function LogErrorToFile ()
Dim objFS
Dim objFile
On Error Resume Next
LogError = False
Set objFS = Server.CreateObject ("Scripting.FileSystemObject")
If Err.number = 0 Then
Set objFile = objFS.OpenTextFile (mstrFileName, 8, True)
If Err.number = 0 Then
objFile.WriteLine "------------------------------------------------------"
objFile.WriteLine "* Error At " & Now
objFile.WriteLine "* CustomerRefID " & mstrCustRefID
objFile.WriteLine "* Session ID " & Session.SessionID
objFile.WriteLine "* RequestMethod " & Request.ServerVariables("REQUEST_METHOD")
objFile.WriteLine "* ServerPort " & Request.ServerVariables("SERVER_PORT")
objFile.WriteLine "* HTTPS " & Request.ServerVariables("HTTPS")
objFile.WriteLine "* LocalAddr " & Request.ServerVariables("LOCAL_ADDR")
objFile.WriteLine "* HostAddress " & Request.ServerVariables("REMOTE_ADDR")
objFile.WriteLine "* UserAgent " & Request.ServerVariables("HTTP_USER_AGENT")
objFile.WriteLine "* URL " & Request.ServerVariables("URL")
If ASPErr.ASPCode <> "" Then objFile.WriteLine "* Error #: " & ASPErr.ASPCode
If ASPErr.Number <> 0 Then objFile.WriteLine "* COM Error #: " & ASPErr.Number & " (" & Hex (ASPErr.Number) & ")"
If ASPErr.Source <> "" Then objFile.WriteLine "* Source: " & ASPErr.Source
If ASPErr.Category <> "" Then objFile.WriteLine "* Category: " & ASPErr.Category
If ASPErr.File <> "" Then objFile.WriteLine "* File: " & "//" & Request.ServerVariables ("SERVER_NAME") & ASPErr.File
If ASPErr.Line <> 0 Then objFile.WriteLine "* Line, Column:" & ASPErr.Line & ", " & ASPErr.Column
If ASPErr.Description <> "" Then objFile.WriteLine "* Description: " & ASPErr.Description
If ASPErr.ASPDescription <> "" Then objFile.WriteLine "* ASP Desc: " & ASPErr.ASPDescription
objFile.WriteLine "* FormData " & Request.Form
objFile.WriteLine "* HTTP Headers: "
objFile.WriteLine "*****************************"
objFile.WriteLine Replace(Request.ServerVariables("ALL_HTTP"),vbLf,vbCrLf)
objFile.WriteLine "*****************************"
objFile.WriteLine "------------------------------------------------------" & vbCrLf
objFile.Close
End If
End If
End Function
Sub LogErrorToDatabase()
Dim con
Dim rstError
Set con = Server.CreateObject("ADODB.Connection")
Set rstError = Server.CreateObject("ADODB.Recordset")
con.open "dsn=ErrorLog;uid=ErrorLog;pwd=secret;"
Set rstError.ActiveConnection = con
rstError.Open "Select * From Errors",,3,3 'adOpenStatic, adLockOptimistic
rstError.AddNew
With rstError
.Fields("SessionID") = Session.SessionID
.Fields("RequestMethod").Value = Request.ServerVariables("REQUEST_METHOD")
.Fields("ServerPort").Value = Request.ServerVariables("SERVER_PORT")
.Fields("HTTPS").Value = Request.ServerVariables("HTTPS")
.Fields("LocalAddr").Value = Request.ServerVariables("LOCAL_ADDR")
.Fields("HostAddress").Value = Request.ServerVariables("REMOTE_ADDR")
.Fields("UserAgent").Value = Request.ServerVariables("HTTP_USER_AGENT")
.Fields("URL").Value = Request.ServerVariables("URL")
.Fields("CustomerRefID").Value = mstrCustRefID
.Fields("FormData").Value = Request.Form
.Fields("AllHTTP").Value = Replace(Request.ServerVariables("ALL_HTTP"),vbLf,vbCrLf)
.Fields("ErrASPCode").Value = AspErr.ASPCode
.Fields("ErrNumber").Value = AspErr.Number
.Fields("ErrSource").Value = AspErr.Source
.Fields("ErrCategory").Value = AspErr.Category
.Fields("ErrFile").Value = AspErr.File
.Fields("ErrLine").Value = AspErr.Line
.Fields("ErrColumn").Value = AspErr.Line
.Fields("ErrDescription").Value = AspErr.Description
.Fields("ErrAspDescription").Value = AspErr.AspDescription
.Fields("InsertDate").Value = Now()
End With
rstError.Update
rstError.Close
con.Close
Set rstError = Nothing
Set con = Nothing
End Sub
%>
<html>
<head>
<title>Teknisk uheld</title>
</head>
<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0">
<!---------- START - Body Content -------------------------------->
<center><br><br>
<h3>Der er sket en fejl.</h3>
<table cellpadding="3">
<tr>
<td colspan="2">
Der er desværre sket en fejl. Information om denne fejl er gemt, og vi er gjort opmærksom på denne.<br>
Du er velkommen til at kontakte os på tlf: 12 34 56 78<br><br>
Vi beklager ulejligheden.
</td>
</tr>
<tr>
<td colspan=2>Ved evt. kontakt, venligst oplys dette nummer: <b><%=mstrCustRefID%></b></td>
</tr>
<%If False Then%>
<tr>
<td>ASPCode</td><td><%=AspErr.ASPCode%></td>
</tr>
<tr>
<td>Number</td><td><%=AspErr.Number%></td>
</tr>
<tr>
<td>Source</td><td><%=AspErr.Source%></td>
</tr>
<tr>
<td>Category</td><td><%=AspErr.Category%></td>
</tr>
<tr>
<td>File</td><td><%=AspErr.File%></td>
</tr>
<tr>
<td>Line</td><td><%=AspErr.Line%></td>
</tr>
<tr>
<td>Column</td><td><%=AspErr.Column%></td>
</tr>
<tr>
<td>Description</td><td><%=AspErr.Description%></td>
</tr>
<tr>
<td>ASPDescription</td><td><%=AspErr.ASPDescription%></td>
</tr>
<tr>
<td>URL</td><td><%=Request.ServerVariables("URL")%></td>
</tr>
<%End If%>
</table>
</center>
<!---------- END - Body Content -------------------------------->
</body>
</html>
---------------------------------------------------------------------
Men det er som du skriver nok ikke nemt på et webhotel. Det kan dog lade sig gøre på nogle ved jeg.
