Snippet Library

Option Explicit


Declare Function RegisterEventSource Lib "advapi32.dll" Alias _
        "RegisterEventSourceA" (ByVal lpUNCServerName As String, _
        ByVal lpSourceName As String) As Long
Declare Function DeregisterEventSource Lib "advapi32.dll" ( _
        ByVal hEventLog As Long) As Long
Declare Function ReportEvent Lib "advapi32.dll" Alias _
        "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Integer, _
        ByVal wCategory As Integer, ByVal dwEventID As Long, _
        ByVal lpUserSid As Any, ByVal wNumStrings As Integer, _
        ByVal dwDataSize As Long, plpStrings As Long, _
        lpRawData As Any) As Boolean
Declare Function GetLastError Lib "kernel32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        hpvDest As Any, hpvSource As Any, _
        ByVal cbCopy As Long)
Declare Function GlobalAlloc Lib "kernel32" ( _
        ByVal wFlags As Long, _
        ByVal dwBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32" ( _
        ByVal hMem As Long) As Long

Public Const EVENTLOG_SUCCESS = 0
Public Const EVENTLOG_ERROR_TYPE = 1
Public Const EVENTLOG_WARNING_TYPE = 2
Public Const EVENTLOG_INFORMATION_TYPE = 4
Public Const EVENTLOG_AUDIT_SUCCESS = 8
Public Const EVENTLOG_AUDIT_FAILURE = 10

Public Sub LogNTEvent(sString As String, iLogType As Integer, _
            iEventID As Long)
    Dim bRC As Boolean
    Dim iNumStrings As Integer
    Dim hEventLog As Long
    Dim hMsgs As Long
    Dim cbStringSize As Long

    hEventLog = RegisterEventSource("", App.Title)
    cbStringSize = Len(sString) + 1
    hMsgs = GlobalAlloc(&H40, cbStringSize)
    CopyMemory ByVal hMsgs, ByVal sString, cbStringSize
    iNumStrings = 1
    If ReportEvent(hEventLog, _
            iLogType, 0, _
            iEventID, 0&, _
            iNumStrings, cbStringSize, _
            hMsgs, hMsgs) = 0 Then
        MsgBox GetLastError()
    End If
    Call GlobalFree(hMsgs)
    DeregisterEventSource (hEventLog)
End Sub

Sub Main()
    Call LogNTEvent("Information from " & App.EXEName, _
            EVENTLOG_INFORMATION_TYPE, 1001)
    Call LogNTEvent("Warning from " & App.EXEName, _
            EVENTLOG_WARNING_TYPE, 1002)
    Call LogNTEvent("Error from " & App.EXEName, _
            EVENTLOG_ERROR_TYPE, 1003)
    MsgBox "Done"
End Sub
;