Soyez le premier à donner votre avis sur cette source.
Snippet vu 19 503 fois - Téléchargée 38 fois
Imports System Imports System.Data Imports System.Globalization Imports System.IO Imports System.Net Imports System.Net.Sockets Imports System.Threading Imports System.Web Imports System.Web.Mail Imports System.Web.SessionState Public Class Gestion_Erreur Implements IHttpModule Dim Context As HttpContext = HttpContext.Current ' l'usage de IHttpModule impose l'existence des subs "init" et "dispose". Public Sub Init(ByVal application As HttpApplication) Implements IHttpModule.Init AddHandler application.Error, AddressOf Me.Application_Error End Sub 'Init Public Sub Dispose() Implements IHttpModule.Dispose End Sub 'Dispose Private Sub Application_Error(ByVal [source] As [Object], ByVal e As EventArgs) Dim baliseSTART As String Dim baliseEND As String Dim strMSG As String Dim objErr As Object Dim errPATH As String Dim BL_TRANSMIT_ERROR As Boolean baliseSTART = "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.0 Transitional//FR'>" & vbCrLf & _ "<HTML>" & vbCrLf & _ "<HEAD>" & vbCrLf & _ "<title>Ardag</title><LINK href='Styles.css' type='text/css' rel='stylesheet'>" & vbCrLf & _ "<META content='fr' name='LANGUAGE'>" & vbCrLf & _ "<META http-equiv='content-language' content='fr'>" & vbCrLf & _ "<META content='FRENCH' name='HTTP.LANGUAGE'>" & vbCrLf & _ "<META http-equiv='Content-Type' content='text/html'>" & vbCrLf & _ "<META http-equiv='Pragma' content='no-cache'>" & vbCrLf & _ "<META http-equiv='Expires' content='0'>" & vbCrLf & _ "<META content='Ardag - le site officiel : Retrouvez l'univers d'Ardag. Profitez des dernières news. Découvrez le clip et écoutez les chansons. Biographie, Interview, Musiciens, Musique de film.' name='DESCRIPTION'>" & vbCrLf & _ "<META content='' name='KEYWORDS'>" & vbCrLf & _ "<META content='Francois Rossello' name='AUTHOR'>" & vbCrLf & _ "<META content='Francois Rossello' name='publisher'>" & vbCrLf & _ "<META content='Francois Rossello' name='copyright'>" & vbCrLf & _ "<META content='Francois Rossello' name='reply-to'>" & vbCrLf & _ "<META content='index,follow' name='robots'>" & vbCrLf & _ "<META content='10' name='revisit-after'>" & vbCrLf & _ "<meta content='JavaScript' name='vs_defaultClientScript'>" & vbCrLf & _ "<meta content='http://schemas.microsoft.com/intellisense/ie5' name='vs_targetSchema'>" & vbCrLf & _ "</HEAD>" & vbCrLf & _ "<body>" & vbCrLf & _ "<TABLE WIDTH=100% HEIGHT=100% cellspacing=4 cellpadding=4 border=1>" baliseEND = "</TABLE>" & vbCrLf & _ "</body>" & vbCrLf & _ "</html>" ' ### Informations toujours disponibles strMSG = strMSG & "<TR><TD>Heure GMT</TD><TD>" & System.DateTime.Now.ToUniversalTime.ToString & "</TD></TR>" strMSG = strMSG & "<TR><TD>Est authentifié ?</TD><TD>" & Context.Request.IsAuthenticated & "</TD></TR>" strMSG = strMSG & "<TR><TD>La connexion est sécurisée ?</TD><TD>" & Context.Request.IsSecureConnection() & "</TD></TR>" strMSG = strMSG & "<TR><TD>HTTP_REFERER</TD><TD>" & Context.Request.ServerVariables("HTTP_REFERER") & "</TD></TR>" strMSG = strMSG & "<TR><TD>Fichier</TD><TD>" & Context.Request.PhysicalPath & "</TD></TR>" strMSG = strMSG & "<TR><TD>URL</TD><TD>" & Context.Request.RawUrl & "</TD></TR>" ' ### information server et session If Context.Session Is Nothing Then strMSG = strMSG & "<TR><TD>Session</TD><TD>Ko</TD></TR>" strMSG = strMSG & "<TR><TD>Server</TD><TD>Ko</TD></TR>" strMSG = strMSG & "<TR><TD>ID_VISIT</TD><TD>" & myParams.ID_VISIT & "</TD></TR>" strMSG = strMSG & "<TR><TD>Erreur context</TD><TD>" & HttpContext.Current.Error.ToString() & "</TD></TR>" Else strMSG = strMSG & "<TR><TD>Session</TD><TD>" & Context.Session.SessionID & "</TD></TR>" strMSG = strMSG & "<TR><TD>Erreur serveur</TD><TD>" & Context.Server.GetLastError.InnerException.ToString & "</TD></TR>" strMSG = strMSG & "<TR><TD>ID_VISIT</TD><TD>" & myParams.ID_VISIT & "</TD></TR>" strMSG = strMSG & "<TR><TD>Erreur context</TD><TD>" & HttpContext.Current.Error.ToString() & "</TD></TR>" End If objErr = baliseSTART & strMSG & getVisiteurInfo_mail() & baliseEND ' Détermine le chemin de l'erreur et son nom de fichier. errPATH = Context.Request.PhysicalApplicationPath & "Logs\Err_" & System.DateTime.Now.ToUniversalTime.Ticks.ToString & ".htm" ' ecrire l erreur sur le disque et l'envoyer par e-mail BL_TRANSMIT_ERROR = LOGError(errPATH, objErr) And MAILError(objErr) End Sub 'Application_Error Private Function LOGError(ByVal errPATH As String, ByVal objErr As Object) On Error GoTo GestErr ' ### Ecriture d'une erreur sur le disque dans le repertoire errPATH. Dim noFile As Integer = FreeFile() FileSystem.FileOpen(noFile, errPATH, OpenMode.Output, OpenAccess.Write, OpenShare.Shared) FileSystem.Print(noFile, objErr) FileSystem.FileClose(noFile) Return True Exit Function GestErr: Err.Clear() ' si par exemple le disque est plein il faut continuer pour envoyer le mail Return False End Function Private Function MAILError(ByVal objErr As Object) Dim ErrMail As New MailMessage() With ErrMail .From = "postmaster@ardag-music.com" .To = "postmaster@ardag-music.com" .Subject = "Erreur sur le Site www.ardag-music.com" .BodyFormat = MailFormat.Html .Priority = MailPriority.Normal .Body = objErr End With SmtpMail.SmtpServer = "mail.ardag-music.com" SmtpMail.Send(ErrMail) Return True Exit Function End Function Private Function getVisiteurInfo_mail() As String Dim strVisiteur As String Dim strIP As String Dim strNM As String Dim item As Object On Error Resume Next ' cas ou context.session is nothing strIP = GetUsrIp() strNM = getHostName(strIP) strVisiteur = strVisiteur & "<TR><TD>DT_VISIT</TD><TD>" & System.DateTime.Now & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>IP_VISIT</TD><TD>" & strIP & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>NM_VISIT</TD><TD>" & strNM & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>HTTP_REFERER</TD><TD>" & Context.Request.ServerVariables("HTTP_REFERER") & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>SessionID</TD><TD>" & Context.Session.SessionID & "</TD></TR>" With Context.Request strVisiteur = strVisiteur & "<TR><TD>AcceptTypes</TD><TD>" & Left(Join(.AcceptTypes), 255) & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>UserLanguages</TD><TD>" & Join(.UserLanguages) & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>HasKeys</TD><TD>" & .ServerVariables.HasKeys.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>UserAgent</TD><TD>" & .UserAgent.ToString & "</TD></TR>" End With With Context.Request.Browser strVisiteur = strVisiteur & "<TR><TD>ActiveXControls</TD><TD>" & .ActiveXControls.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>AOL</TD><TD>" & .AOL.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>BackgroundSounds</TD><TD>" & .BackgroundSounds.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Beta</TD><TD>" & .Beta.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Browser</TD><TD>" & .Browser.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>CDF</TD><TD>" & .CDF.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>ClrVersion</TD><TD>" & .ClrVersion.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Cookies</TD><TD>" & .Cookies.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Crawler</TD><TD>" & .Crawler.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>EcmaScriptVersion</TD><TD>" & .EcmaScriptVersion.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Frames</TD><TD>" & .Frames.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>JavaApplets</TD><TD>" & .JavaApplets.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>JavaScript</TD><TD>" & .JavaScript.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>MajorVersion</TD><TD>" & .MajorVersion & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>MinorVersion</TD><TD>" & .MinorVersion & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>MSDomVersion</TD><TD>" & .MSDomVersion.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Platform</TD><TD>" & .Platform & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Tables</TD><TD>" & .Tables.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>TagWriter</TD><TD>" & .TagWriter.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Type</TD><TD>" & .Type.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>VBScript</TD><TD>" & .VBScript.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Version</TD><TD>" & .Version.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>W3CDomVersion</TD><TD>" & .W3CDomVersion.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Win16</TD><TD>" & .Win16.ToString & "</TD></TR>" strVisiteur = strVisiteur & "<TR><TD>Win32</TD><TD>" & .Win32.ToString & "</TD></TR>" End With ' listing de toutes les variables serveur For Each item In Context.Request.ServerVariables strVisiteur = strVisiteur & "<TR><TD>" & item & "</TD><TD>" & _ Context.Request.ServerVariables(item) & "</TD></TR>" Next On Error GoTo 0 ' obligatoirement désactiver on error resume next avant de quitter une fonction Return strVisiteur End Function Private Function getHostName(ByVal adIp As String) As String ' nom machine du visiteur Dim sIP As String Dim posCHAR As Int16 posCHAR = InStr(adIp, ":", CompareMethod.Text) adIp = Mid(adIp, posCHAR + 1) Dim myIP As IPHostEntry = Dns.Resolve(adIp) sIP = myIP.HostName 'sIP += ("Adresse IP :" & myIP.AddressList(0).ToString & "<br>") Return sIP End Function Private Function GetUsrIp() As String ' retrouver l'adresse d'origine si le visiteur est derriere un proxy GetUsrIp = Context.Request.ServerVariables("REMOTE_HOST") If Context.Request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" Then GetUsrIp = GetUsrIp & ":" & Context.Request.ServerVariables("HTTP_X_FORWARDED_FOR") End If End Function End Class
Cependant comment l'instancié dans un code?
ps: c'est pour ca que je ne met pas 10 :p , pour un débutant je pense que l'instanciation est aussi importante!
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.