Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Specialized
Imports System.Configuration
Imports System.IO
Imports System.Text
Imports System.Web
Imports System.Data
Imports System.Data.SqlClient
Imports System.Diagnostics
Public Class LoggingFilter
    Implements IHttpModule
  Private httpApp As HttpApplication
  Private responseStream As EchoStream
  Private logFileName As String
  Private maxLogSize As Long
  Private dbConnString As String = String.Empty
  Private strServer As String = String.Empty
  Private strDatabase As String = String.Empty
  Private strUser As String = String.Empty
  Private strPassword As String = String.Empty
    Public Overridable Sub Init(ByVal httpApp As HttpApplication) Implements IHttpModule.Init
        Me.httpApp = httpApp
        Dim flag As Boolean
        GetSettings(flag, logFileName, maxLogSize)
        If Not flag Then
            Return
        End If
        If logFileName Is Nothing Then
            Return
        End If
        AddHandler httpApp.BeginRequest, AddressOf Me.OnBeginRequest
        AddHandler httpApp.EndRequest, AddressOf Me.OnEndRequest
    End Sub
    Private Sub GetSettings(ByRef filterEnabled As Boolean, ByRef logFileName As String,  _
ByRef maxLogSize As Long)
        Dim i As Integer
        Dim flag As Boolean = False
        filterEnabled = 0
        logFileName = Nothing
        maxLogSize = 0
        Dim enabledFlagFound As Boolean = False
        Dim key As String
        Dim configKeys As String() = ConfigurationSettings.AppSettings.AllKeys
        For Each key In configKeys
            Select Case key
                Case "LoggingFilter.LogFile"
                    logFileName = ConfigurationSettings.AppSettings("LoggingFilter.LogFile")
                Case "LoggingFilter.Enabled"
 filterEnabled = IIf(ConfigurationSettings.AppSettings("LoggingFilter.Enabled") = "true", _
 True, False)
                    enabledFlagFound = True
                Case "LoggingFilter.ResetLogSize"
 maxLogSize = Long.Parse(ConfigurationSettings.AppSettings("LoggingFilter.ResetLogSize"))
                Case "LoggingFilter.dbConnstring"
        Dim strText As String = ConfigurationSettings.AppSettings("LoggingFilter.dbConnstring")
                    If strText.Length > 0 Then
                        Dim strParms As String() = strText.Split(Convert.ToChar("|"))
                        strServer = strParms(0)
                        strDatabase = strParms(1)
                        strUser = strParms(2)
                        strPassword = strParms(3)
dbConnString = "server=" & strServer & ";Database=" & strDatabase _
  & ";User Id=" & strUser & ";password=" & strPassword
                    End If
            End Select
        Next
        '   If the LoggingFilter.Enabled key was set in the config file,
        '  then just leave filterEnabled as it was configured.  If the
        '  LoggingFilter.Enabled key wasn't in the config file at all,
        '  the default behavior will be to enable the filter as long as
        '  a file name was specified. The dbConnectionString key overrides files
        '  to write records to the database table.
        If Not enabledFlagFound Then
            filterEnabled = (logFileName <> Nothing)
        End If
    End Sub
    Private Sub OnBeginRequest(ByVal sender As Object, ByVal a As EventArgs)
        Dim flag As Boolean = False
        If maxLogSize > CLng(0) AndAlso File.Exists(logFileName) Then
            flag = New FileInfo(logFileName).Length < maxLogSize = False
        End If
        Dim stream As stream = File.Open(logFileName, _
           IIf(Not flag, FileMode.Append, FileMode.Truncate), FileAccess.Write)
        LogRequestInfo(stream)
        responseStream = New EchoStream(httpApp.Response.Filter, stream)
        httpApp.Response.Filter = responseStream
    End Sub
    Private Sub OnEndRequest(ByVal sender As Object, ByVal a As EventArgs)
        If Not responseStream Is Nothing Then
            responseStream.Close()
        End If
    End Sub
    Private Sub LogRequestInfo(ByVal logFile As Stream)
        If dbConnString.Length < 2 Then
            Dim locals As Object() = New Object() {DateTime.Now}
            WriteLine(logFile, Chr(10) & Chr(10) & "Request: {0}", locals)
            WriteLine(logFile, httpApp.Request.Url.ToString(), New Object(-1) {})
            locals = New Object() {httpApp.Request.HttpMethod, httpApp.Request.ContentType, _
                 httpApp.Request.ContentLength, httpApp.Request.ContentEncoding.EncodingName}
            WriteLine(logFile, "{0}, type: {1}, length: {2}, encoding: {3}", locals)
            WriteLine(logFile, "Request Content:", New Object(-1) {})
            Dim l As Long = httpApp.Request.InputStream.Position
            CopyStream(httpApp.Request.InputStream, logFile)
            httpApp.Request.InputStream.Position = l
            WriteLine(logFile, Chr(10) & "Response:", New Object(-1) {})
        Else
            Dim strSql As String = "INSERT INTO HTTPLOGITEMS "
            strSql += "( LogDateTime,RequestUrl,RequestMethod,RequestContentType,"
            strSql += "RequestContentLength,RequestContentEncoding,RequestContentBody ) "
            strSql += " VALUES "
            strSql += "('"
            strSql += DateTime.Now.ToString()
            strSql += "','"
            strSql += httpApp.Request.Url.ToString()
            strSql += "','"
            strSql += httpApp.Request.HttpMethod
            strSql += "','"
            strSql += httpApp.Request.ContentType
            strSql += "',"
            strSql += httpApp.Request.ContentLength.ToString()
            strSql += ",'"
            strSql += httpApp.Request.ContentEncoding.EncodingName
            strSql += "','"            '
            Dim ms As New MemoryStream()
            Dim l As Long = httpApp.Request.InputStream.Position
            Dim str As Stream = httpApp.Request.InputStream
            Dim strLen As Integer = CInt(str.Length)
            Dim strArr(strLen) As Byte
            Dim strRead As Integer = str.Read(strArr, 0, strLen)
            httpApp.Request.InputStream.Position = l
            Dim strContent As String
            strContent = System.Text.Encoding.UTF8.GetString(strArr)
            strSql += strContent
            strSql += "')"
            Dim cn1 As New SqlConnection(dbConnString)
            cn1.Open()
            Dim cmd As New SqlCommand()
            cmd.Connection = cn1
            cmd.CommandText = strSql
            Dim res As Integer = cmd.ExecuteNonQuery()
        End If
    End Sub
Private Sub WriteLine(ByVal s As Stream, ByVal format As String, _
ByVal ParamArray args As Object())
        If dbConnString.Length < 2 Then
            Dim str As String = String.Format(String.Concat(format, Chr(10)), args)
            Dim bs As Byte() = Encoding.ASCII.GetBytes(str)
            s.Write(bs, 0, CInt(bs.Length))
        End If
    End Sub
    Private Sub CopyStream(ByVal inStream As Stream, ByVal outStream As Stream)
        Dim bs As Byte() = New Byte(127) {}
        Dim i As Integer = 0
        While (i = inStream.Read(bs, 0, CInt(bs.Length))) > 0
            outStream.Write(bs, 0, i)
        End While
    End Sub
    Public Overridable Sub Dispose() Implements IHttpModule.Dispose
    End Sub
End Class

Imports Microsoft.VisualBasic
Imports System
Imports System.IO
Public Class EchoStream
    Inherits Stream
    Private primaryStream As Stream
    Private otherStream As Stream
    Public Overrides ReadOnly Property CanRead() As Boolean
        Get
            Return primaryStream.CanRead
        End Get
    End Property
    Public Overrides ReadOnly Property CanSeek() As Boolean
        Get
            Return primaryStream.CanSeek
        End Get
    End Property
    Public Overrides ReadOnly Property CanWrite() As Boolean
        Get
            Return primaryStream.CanWrite
        End Get
    End Property
    Public Overrides ReadOnly Property Length() As Long
        Get
            Return primaryStream.Length
        End Get
    End Property
    Public Overrides Property Position() As Long
        Get
            Return primaryStream.Position
        End Get
        Set(ByVal value As Long)
            Dim l As Long
            otherStream.Position = l = value
            primaryStream.Position = l
        End Set
    End Property
    Public Sub New(ByVal primaryStream As Stream, ByVal otherStream As Stream)
        Me.primaryStream = primaryStream
        Me.otherStream = otherStream
    End Sub
    Public Overrides Function Seek(ByVal offset As Long, ByVal direction As SeekOrigin) As Long
        Dim l As Long = primaryStream.Seek(offset, direction)
        If otherStream.Seek(offset, direction) <> l Then
            Throw New ApplicationException("Failed to keep streams in sync while seeking.")
        Else
            Return l
        End If
    End Function
    Public Overrides Sub SetLength(ByVal length As Long)
        primaryStream.SetLength(length)
        otherStream.SetLength(length)
    End Sub
    Public Overrides Sub Close()
        primaryStream.Close()
        otherStream.Close()
    End Sub
    Public Overrides Sub Flush()
        primaryStream.Flush()
        otherStream.Flush()
    End Sub
    Public Overrides Function Read(ByVal buffer As Byte(), ByVal offset As Integer, _
                           ByVal count As Integer) As Integer
        Dim i As Integer = primaryStream.Read(buffer, offset, count)
        otherStream.Position = primaryStream.Position
        Return i
    End Function
    Public Overrides Sub Write(ByVal buffer As Byte(), _
 ByVal offset As Integer, ByVal count As Integer)
        primaryStream.Write(buffer, offset, count)
        otherStream.Write(buffer, offset, count)
    End Sub
    Public Overrides Function ReadByte() As Integer
        Dim i As Integer = primaryStream.ReadByte()
        otherStream.Position = primaryStream.Position
        Return i
    End Function
    Public Overrides Sub WriteByte(ByVal b As Byte)
        primaryStream.WriteByte(b)
        otherStream.WriteByte(b)
    End Sub
End Class