Solved

Writing Event Log

Posted on 1998-12-16
1
248 Views
Last Modified: 2010-05-18
How can i write to NT's Event Log with VB
0
Comment
Question by:lmira
1 Comment
 
LVL 14

Accepted Solution

by:
waty earned 50 total points
ID: 1450492
Use the following class :

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 28/09/98
' * Time             : 10:42
' * Module Name      : class_EventLog
' * Module Filename  : EventLog.cls
' **********************************************************************
' * Comments         : Add event to the enventlog under NT
' *
' *
' **********************************************************************

Option Explicit

'=============================================
'Module Level Constant Declaration Section
'=============================================
Private Const RAW_TYPE_NONE = 0
Private Const RAW_TYPE_BYTE = 1
Private Const RAW_TYPE_LONG = 2

'=============================================
'Module Level Variable Declaration Section
'=============================================
Private m_hEventSource  As Long        'Event source handle
Private m_sEventSource  As String      'Event source name
Private m_lEventID      As Long        'Event ID
Private m_nEventType    As Integer     'Event type
Private m_nRawDataType  As Integer     'Type of the raw data
Private m_bRawData()    As Byte        'Raw byte data
Private m_lRawData()    As Long        'Raw long data
Private m_lRawDataSize  As Long        'Size of the raw data
Private m_sStringParam  As String      'Substitution string
Private m_lNumStrings   As Long        '1=string present, 0=not present

Public Property Let EventSource(Source As String)
   ' *** This property is used to set the source of the event.
   ' *** The name of a source defined in the registry.

   m_sEventSource = Source

End Property

Public Property Let EventID(ID As Long)
   ' *** This property is used to set the ID of the event.
   ' *** The IDs are defined in the message file for the
   ' *** particular source.
   
   m_lEventID = ID

End Property

Public Property Let EventType(EType As Integer)
   ' *** This property is used to set the type of the event.
   ' *** Event types are defined in EventLog.bas

   If EType = EVENTLOG_ERROR_TYPE Or EType = EVENTLOG_INFORMATION_TYPE Or EType = EVENTLOG_WARNING_TYPE Then m_nEventType = EType

End Property

Public Property Let RawData(ByRef data As Variant)
   ' *** This property is used to set the value of the raw data
   ' *** to be written to the event log.
   
   ' *** Data : The raw data to be written to the log
   ' ***        This must be either a value or array of any
   ' ***        of the following types: Long, Integer, Byte

   '   =============================================
   '   Local Constant/Variable Declaration Section
   '   =============================================
   Dim nElement   As Integer
   
   ' *** Determine the type and size of the data
   Select Case TypeName(data)
      Case "Long()"
         ' *** Array of longs
         
         m_nRawDataType = RAW_TYPE_LONG
         m_lRawDataSize = (UBound(data) + 1) * 4
         ReDim m_lRawData(UBound(data))
         For nElement = 0 To UBound(data)
             m_lRawData(nElement) = data(nElement)
         Next
         
      Case "Long"
         ' *** Single long
   
         m_nRawDataType = RAW_TYPE_LONG
         m_lRawDataSize = 4
         ReDim m_lRawData(0)
         m_lRawData(0) = data
   
      Case "Byte()"
         ' *** Array of bytes
   
         m_nRawDataType = RAW_TYPE_BYTE
         m_lRawDataSize = UBound(data) + 1
         ReDim m_bRawData(UBound(data))
         For nElement = 0 To UBound(data)
             m_bRawData(nElement) = data(nElement)
         Next
   
      Case "Byte"
         ' *** Single byte
   
         m_nRawDataType = RAW_TYPE_BYTE
         m_lRawDataSize = 1
         ReDim m_bRawData(0)
         m_bRawData(0) = data
   
      Case Else
         ' *** Invalid type
   
         m_nRawDataType = RAW_TYPE_NONE
         m_lRawDataSize = 0
   
   End Select
   
End Property

Public Property Let StringParam(sParam As String)
   ' *** This method is used to set the substitution string in the event
   ' *** description.

   m_sStringParam = sParam
   m_lNumStrings = IIf(m_sStringParam = "", 0, 1)

End Property

Public Function EventLogReport(Optional Source As Variant, Optional EType As Variant, Optional ID As Variant, Optional ByRef data As Variant, Optional Param As Variant) As Long
   ' *** This method is used to write an event to the Application log.

   ' *** Source The name of the event source (opional, may be set through properties)
   ' *** EType  The type as defined in EventLog.bas (opional, may be set through properties)
   ' *** ID     The ID within the event source (opional, may be set through properties)
   ' *** Data   The array of raw data (opional, may be set through properties)
   ' *** Param  The substitution string (opional, may be set through properties)

   Dim lCatagory    As Long
   Dim lResult      As Long
   Dim vUserSiD     As Variant
   
   EventLogReport = 0
   lCatagory = 0
   vUserSiD = Null
   
   ' *** Check if parameters passed
   If Not IsMissing(Source) Then EventSource = Source
   If Not IsMissing(ID) Then EventID = ID
   If Not IsMissing(EType) Then EventType = EType
   If Not IsMissing(data) Then RawData = data
   If Not IsMissing(Param) Then StringParam = Param
   
   ' *** Get an handle to the event log
   m_hEventSource = RegisterEventSource(vbNullString, m_sEventSource)
   
   ' *** If registration was successful, report event
   If m_hEventSource <> 0 Then
      Select Case m_nRawDataType
         Case RAW_TYPE_BYTE
            lResult = ReportEvent(m_hEventSource, m_nEventType, lCatagory, m_lEventID, vUserSiD, m_lNumStrings, m_lRawDataSize, m_sStringParam, m_bRawData(0))
   
         Case RAW_TYPE_LONG
            lResult = ReportEvent(m_hEventSource, m_nEventType, lCatagory, m_lEventID, vUserSiD, m_lNumStrings, m_lRawDataSize, m_sStringParam, m_lRawData(0))
   
         Case RAW_TYPE_NONE
            lResult = ReportEvent(m_hEventSource, m_nEventType, lCatagory, m_lEventID, vUserSiD, m_lNumStrings, m_lRawDataSize, m_sStringParam, vbNullString)
     
      End Select
   
      ' *** If report event failed, get the error number
      If lResult = 0 Then EventLogReport = GetLastError()
   
      ' *** Release the handle and reset the variables
      lResult = DeregisterEventSource(m_hEventSource)
      m_sEventSource = ""
      m_lEventID = 0
      m_nEventType = EVENTLOG_INFORMATION_TYPE
      m_nRawDataType = RAW_TYPE_NONE
      m_lRawDataSize = 0
      m_sStringParam = ""
      m_lNumStrings = 0
   
   Else
      EventLogReport = GetLastError()
   
   End If
   
End Function

Public Function EventLogBackup(sFileName As Variant, Optional Source As Variant) As Long
   ' *** This method is used to backup the event log.

   ' *** Source The name of the event source (opional, may be set through properties)

   Dim lResult       As Long
   
   ' *** Check if parameters passed
   If Not IsMissing(Source) Then EventSource = Source

   ' *** Get an handle to the event log
   m_hEventSource = RegisterEventSource(vbNullString, m_sEventSource)
   
   If m_hEventSource <> 0 Then
      lResult = BackupEventLog(m_hEventSource, sFileName)
     
      ' *** If report event failed, get the error number
      If lResult = 0 Then EventLogBackup = GetLastError()
   
      ' *** Release the handle and reset the variables
      lResult = DeregisterEventSource(m_hEventSource)
   
   Else
      EventLogBackup = GetLastError()
   
   End If

End Function

Public Function EventLogClear(Optional Source As Variant) As Long
   ' *** This method is used to clear the event log.

   ' *** Source The name of the event source (opional, may be set through properties)

   Dim lResult       As Long

   ' *** Check if parameters passed
   If Not IsMissing(Source) Then EventSource = Source

   ' *** Get an handle to the event log
   m_hEventSource = RegisterEventSource(vbNullString, m_sEventSource)
   
   If m_hEventSource <> 0 Then
      lResult = ClearEventLog(m_hEventSource, vbNullString)
     
      ' *** If report event failed, get the error number
      If lResult = 0 Then EventLogClear = GetLastError()
   
      ' *** Release the handle and reset the variables
      lResult = DeregisterEventSource(m_hEventSource)
   
   Else
      EventLogClear = GetLastError()
   
   End If
   
End Function

Private Sub Class_Initialize()
   ' *** This procedure is called when the object is instantiated.
   ' *** It initializes the global variables.

   m_sStringParam = ""
   m_nRawDataType = RAW_TYPE_NONE

End Sub

0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

821 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question