Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/rmtlog1a/nteventl.cls

Visual Basic class definition | 1999-03-21 | 4.6 KB | 221 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "NTEventLog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Implements EventLog

Private mobjLog As New EventLog
Private mstrSource As String
Private mstrUNCHost As String
Private hEventLog As Long
Private mbEnabled As Boolean

' Required Interface Elements - EventLog
Private Property Let EventLog_Enabled(ByVal RHS As Boolean)

  Enabled = RHS

End Property

Private Property Get EventLog_Enabled() As Boolean

  EventLog_Enabled = Enabled

End Property

Private Property Let EventLog_EventSource(ByVal RHS As String)

  EventSource = RHS

End Property

Private Property Get EventLog_EventSource() As String

  EventLog_EventSource = EventSource

End Property

Private Property Let EventLog_LogDestination(ByVal RHS As String)

  LogDestination = RHS

End Property

Private Property Get EventLog_LogDestination() As String

  EventLog_LogDestination = LogDestination

End Property

Private Function EventLog_WriteLog(Message As String, EventType As LogEventTypes, EventID As Long) As Boolean

  EventLog_WriteLog = WriteLog(Message, EventType, EventID)

End Function

Private Property Get EventLog_UserName() As String

  EventLog_UserName = UserName

End Property

Private Property Get EventLog_ComputerName() As String

  EventLog_ComputerName = ComputerName

End Property


' Private Member Functions - NTEventLog
Private Sub DisconnectEventSource()

  If hEventLog Then
    DeregisterEventSource (hEventLog)
    hEventLog = 0
  End If

  mbEnabled = (hEventLog <> 0)

End Sub
Private Sub ConnectEventSource()

  If hEventLog Then
    Err.Raise vbObjectError + ERR_CONNECT_FAILED, App.Title, "Cannot connect to Event Log - Log Handle is already allocated"
    Exit Sub
  End If

  On Error GoTo ConnectFailure

  hEventLog = RegisterEventSource(mstrUNCHost, mstrSource)

  mbEnabled = (hEventLog <> 0)

  Exit Sub

ConnectFailure:
  Err.Raise vbObjectError + Err.Number, App.Title, Err.Description

End Sub

' Public Interface Members - NTEventLog
Public Function WriteLog(Message As String, EventType As LogEventTypes, EventID As Long) As Boolean

  Dim hMsg As Long
  Dim cLen As Long
  Dim iCount As Integer
  Dim iType As Integer

  iType = EventType

  cLen = Len(Message) + 1

  hMsg = GlobalAlloc(GMEM_ZEROINIT, cLen)
  CopyMemory ByVal hMsg, ByVal Message, cLen
  iCount = 1

  If ReportEvent(hEventLog, iType, CInt(0), EventID, CLng(0), iCount, cLen, hMsg, CLng(0)) = 0 Then
    WriteLog = False
  Else
    WriteLog = True
  End If

  Call GlobalFree(hMsg)

End Function

Private Sub Class_Terminate()

  DisconnectEventSource

End Sub

Public Property Get EventSource() As String

  EventSource = mstrSource

End Property

Public Property Let EventSource(ByVal vNewValue As String)

  If mbEnabled Then
    Err.Raise vbObjectError + ERR_SOURCE_DISABLED, App.Title, "Can't set EventSource property while Enabled = True"
    Exit Property
  End If

  If Trim(vNewValue) = "" Then
    Err.Raise vbObjectError + ERR_SOURCE_NULL, App.Title, "EventSource can't be a zero-length string"
    Exit Property
  End If

  mstrSource = vNewValue

End Property

Public Property Get LogDestination() As String

  LogDestination = mstrUNCHost

End Property

Public Property Let LogDestination(ByVal vNewValue As String)

  If mbEnabled Then
    Err.Raise vbObjectError + ERR_LOGDEST_DISABLED, App.Title, "Can't change LogDestination while Enabled property = True"
    Exit Property
  End If

  If Trim(vNewValue) = "" Then
    Err.Raise vbObjectError + ERR_LOGDEST_NULL, App.Title, "LogDestination can't be a zero-length string"
    Exit Property
  End If

  mstrUNCHost = vNewValue

End Property

Public Property Get Enabled() As Boolean

  Enabled = mbEnabled

End Property

Public Property Let Enabled(ByVal NewEnabled As Boolean)

  If mbEnabled = NewEnabled Then
    Exit Property
  End If

  If mbEnabled Then
    DisconnectEventSource
  Else
    ConnectEventSource
  End If

End Property

Private Property Get UserName() As String

  UserName = mobjLog.UserName

End Property

Private Property Get ComputerName() As String

  ComputerName = mobjLog.ComputerName

End Property