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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
Imports System.Management
Imports System.Net
PublicClass UserControl1
PrivateSub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Try
WriteLog(1, "Ceci est un test...")
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Erreur")
EndTry
EndSub
PublicSub WriteLog(ByVal Type AsInteger, ByVal MsgLog AsString)
Dim nomDNS AsString = System.Net.Dns.GetHostEntry("localhost").HostName
Dim adresseIp AsString = getIpAddress(nomDNS)
Dim heure AsString = Date.Now
Dim strMACAddress AsString = getMacAdress()
Dim ArkTS AsNew System.Diagnostics.TextWriterTraceListener("C:\APM.log")
ArkTS.TraceOutputOptions = TraceOptions.DateTime
ArkTS.TraceOutputOptions += TraceOptions.ProcessId
ArkTS.TraceOutputOptions += TraceOptions.ThreadId
ArkTS.Name = "Arkheos"
Dim eventCache AsNew TraceEventCache
SelectCase Type
Case 1
ArkTS.TraceEvent(eventCache, vbNewLine & "PST : ", TraceEventType.Information, 1, "Utisateur: " & Environment.UserName.ToString & " | Machine: " & nomDNS.ToUpper & "/" & adresseIp & " | Mac : " & strMACAddress & " | " & MsgLog)
Case 2
ArkTS.TraceEvent(eventCache, vbNewLine & "PST : ", TraceEventType.Error, 2, "Utisateur: " & My.User.Name & " | Machine: " & nomDNS & "/" & adresseIp & " | Mac : " & strMACAddress & " | " & MsgLog)
Case 3
ArkTS.TraceEvent(eventCache, vbNewLine & "PST : ", TraceEventType.Critical, 3, "Utisateur: " & My.User.Name & " | Machine: " & nomDNS & "/" & adresseIp & " | Mac : " & strMACAddress & " | " & MsgLog)
Case 4
ArkTS.TraceEvent(eventCache, vbNewLine & "PST : ", TraceEventType.Warning, 4, "Utisateur: " & My.User.Name & " | Machine: " & nomDNS & "/" & adresseIp & " | Mac : " & strMACAddress & " | " & MsgLog)
EndSelect
ArkTS.Flush()
ArkTS.Close()
EndSub
Function NewMsg(ByVal chaine AsString) AsString
'Si il detecte un apostrophe dans la string
If InStr(chaine, "'") <> 0 Then
'alors on le remplace avec double apostrophe
NewMsg = Replace(chaine, "'", "''")
Return NewMsg
Else
Return chaine
EndIf
EndFunction
PublicFunction getIpAddress(ByVal host AsString)
Dim adresse AsString
Dim IP As IPHostEntry
IP = Dns.GetHostEntry(host)
If Environment.OSVersion.VersionString.Contains("6.0") Then
adresse = IP.AddressList(1).ToString
Return adresse
ElseIf Environment.OSVersion.VersionString.Contains("5.1") Then
adresse = IP.AddressList(0).ToString
Return adresse
Else
adresse = IP.AddressList(0).ToString
Return adresse
EndIf
EndFunction
PublicFunction getMacAdress()
Try
Dim strMACAddress AsString = ""
Dim strQuery AsString = _
"SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True"
' Create a ManagementObjectSearcher object passing in the query to run.
Dim query As ManagementObjectSearcher = New ManagementObjectSearcher(strQuery)
' Create a ManagementObjectCollection assigning it the results of the query.
Dim queryCollection As ManagementObjectCollection = query.Get()
' Loop through the results extracting the MAC Address.
Dim mo As ManagementObject
ForEach mo In queryCollection
strMACAddress = mo("MacAddress").ToString().Replace(":", "")
ExitFor
Next
Return strMACAddress
Catch ex As Exception
Return""
EndTry
EndFunction
EndClass |
