WIN API ReportEvent x64
#37191916
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
|
|
для x64 лучше в реестре заранее зарегистрировать свою аппликацию, чтобы эвенты можно было писать
1. 2. 3. 4. 5. 6. 7. 8. 9. 10. 11. 12. 13. 14. 15. 16. 17. 18. 19. 20. 21. 22. 23. 24. 25. 26. 27. 28. 29. 30. 31. 32. 33. 34. 35. 36. 37. 38. 39. 40. 41. 42. 43. 44. 45. 46. 47. 48. 49. 50. 51. 52. 53. 54. 55.
Option Explicit
Private Declare Function RegisterEventSource Lib "advapi32.dll" Alias "RegisterEventSourceA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long
Private Declare Function DeregisterEventSource Lib "advapi32.dll" (ByVal hEventLog As Long) As Long
Private 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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Enum EventTypeEnum
EVENTLOG_SUCCESS = 0
EVENTLOG_ERROR_TYPE = 1
EVENTLOG_WARNING_TYPE = 2
EVENTLOG_INFORMATION_TYPE = 4
EVENTLOG_AUDIT_SUCCESS = 8
EVENTLOG_AUDIT_FAILURE = 10
End Enum
Public Sub LogNTEvent(EventString As String, Optional EvenType As EventTypeEnum = EVENTLOG_INFORMATION_TYPE)
Const EVT_PATH = "SYSTEM\CurrentControlSet\Services\EventLog\Application\"
Dim hEventLog As Long
Dim hMsgs As Long
Dim cbStringSize As Long
On Error GoTo ErrorHandler
Dim EventID As Long
Select Case EvenType
Case EVENTLOG_SUCCESS: EventID = &H0
Case EVENTLOG_ERROR_TYPE: EventID = &HC0000001
Case EVENTLOG_WARNING_TYPE: EventID = &H80000002
Case EVENTLOG_INFORMATION_TYPE: EventID = &H40000004
End Select
' Register application
Dim EventMessageFile As String: EventMessageFile = App.Path & "\" & App.EXEName & ".DLL"
If RegGetKeyValue(HKEY_LOCAL_MACHINE, EVT_PATH & App.EXEName, "EventMessageFile") <> EventMessageFile Then
RegSetKeyValue HKEY_LOCAL_MACHINE, EVT_PATH & App.EXEName, "EventMessageFile", App.Path & "\" & App.EXEName & ".DLL"
End If
' Write to event log
hEventLog = RegisterEventSource("", App.EXEName)
If hEventLog = 0 Then Err.Raise 13 , "LogNTEvent", "RegisterEventSource failed " & Err.LastDllError
cbStringSize = Len(EventString) + 1
hMsgs = GlobalAlloc(&H40, cbStringSize)
If hMsgs = 0 Then Err.Raise 13
CopyMemory ByVal hMsgs, ByVal EventString, cbStringSize
Call ReportEvent(hEventLog, EvenType, 0 , EventID, 0 &, 1 , 0 , hMsgs, 0 )
Call GlobalFree(hMsgs)
Call DeregisterEventSource(hEventLog)
Exit Sub
ErrorHandler:
If hMsgs <> 0 Then Call GlobalFree(hMsgs)
If hEventLog <> 0 Then Call DeregisterEventSource(hEventLog)
End Sub
|
|