VB6 也可以写入NT 日志

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

可以新建一个MODULE去直接运行它!

Note:
It comes from Microsoft KB

Article ID	:	154576
Last Review	:	July 15, 2004
Revision	:	1.0