[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 249
  • Last Modified:

App.LogEvent with red Error Icon?

I would like to write Messages to the NT-EventLog not with the blue Application-Info-Symbol but with a red Error-Icon. I use App.LogEvent.
Is it possible and how?

db
0
db_tiger
Asked:
db_tiger
  • 2
  • 2
1 Solution
 
watyCommented:
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:41
' * Module Name      : EventLog_Module
' * Module Filename  : EventLog.Bas
' **********************************************************************
' * Comments         : Declarations to add entries to the eventlog
' *
' *
' **********************************************************************

Option Explicit

'=============================================
'API/DLL Procedure Declaration Section
'=============================================

Declare Function GetLastError Lib "kernel32" () As Long
Declare Function DeregisterEventSource Lib "advapi32.dll" (ByVal hEventLog As Long) As Long
Declare Function RegisterEventSource Lib "advapi32.dll" Alias "RegisterEventSourceA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long
Declare Function ClearEventLog Lib "advapi32.dll" Alias "ClearEventLogA" (ByVal hEventLog As Long, ByVal lpBackupFileName As String) As Long
Declare Function BackupEventLog Lib "advapi32.dll" Alias "BackupEventLogA" (ByVal hEventLog As Long, ByVal lpBackupFileName As String) As Long
Declare Function GetNumberOfEventLogRecords Lib "advapi32.dll" (ByVal hEventLog As Long, NumberOfRecords As Long) As Long

' *** NOTICE: The following declare has been modified from Win32API.txt
Declare Function ReportEvent Lib "advapi32.dll" Alias "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Long, ByVal wCategory As Long, ByVal dwEventID As Long, ByRef lpUserSid As Any, ByVal wNumStrings As Long, ByVal dwDataSize As Long, ByRef lpStrings As String, ByRef lpRawData As Any) As Long

Global Const EVENTLOG_ERROR_TYPE = 1
Global Const EVENTLOG_WARNING_TYPE = 2
Global Const EVENTLOG_INFORMATION_TYPE = 4

Type EVENTLOGRECORD
   Length                As Long     '  Length of full record
   Reserved              As Long     '  Used by the service
   RecordNumber          As Long     '  Absolute record number
   TimeGenerated         As Long     '  Seconds since 1-1-1970
   TimeWritten           As Long     '  Seconds since 1-1-1970
   EventID               As Long
   EventType             As Integer
   NumStrings            As Integer
   EventCategory         As Integer
   ReservedFlags         As Integer  '  For use with paired events (auditing)
   ClosingRecordNumber   As Long     '  For use with paired events (auditing)
   StringOffset          As Long     '  Offset from beginning of record
   UserSidLength         As Long
   UserSidOffset         As Long
   DataLength            As Long
   DataOffset            As Long     '  Offset from beginning of record
End Type


' *** Add this in a 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
 
watyCommented:
Take also a look here :

http://support.microsoft.com/support/kb/articles/q154/5/76.asp

http://www.netfokus.dk/vbadmincode/code/wp0996p.zip

http://support.microsoft.com/support/kb/articles/Q216/0/97.ASP
http://support.microsoft.com/support/kb/articles/Q216/1/46.ASP
http://support.microsoft.com/support/kb/articles/Q216/0/89.asp


More simple :

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 28/06/99
' * Time             : 13:20
' **********************************************************************
' * Comments         : Writing to the Windows NT event log
' *
' *
' **********************************************************************

'-- Start Event Logging
Call App.StartLogging("", vbLogToNT)

'-- Log Events to NT
Call App.LogEvent("Info", vbLogEventTypeInformation)
Call App.LogEvent("Error", vbLogEventTypeError)
Call App.LogEvent("Warning", vbLogEventTypeWarning)
0
 
db_tigerAuthor Commented:
In brief: There is no easy way to change the appearance in the NTEventLog - I would have  to use thoses calsses and get some further informations in those urls?

dom
0
 
db_tigerAuthor Commented:
Excuse me - stupid me.

I read the end of your answer too late - there is the simple way, I need.

Thanks for the further infos, I'll take a look at them later.

bye db
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now