| GetUserName |
|
|
| Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ |
| (ByVal lpBuffer As String, nSize As Long) As Long |
|
| Sub Main() |
| Dim LogFile As Integer |
| Dim Messager As String |
| Dim UserName As String |
| Dim CompName As String |
| Dim IPAdress As String |
| Dim textt As String |
|
| Call GetAdresses(textt) |
| |
| UserName = Space(7) |
| LogFile = FreeFile |
| Call LogFil(CompName, IPAdress) |
| Open "C:\LogFile.Log" For Append As #LogFile |
| GetUserName UserName, Len(UserName) |
| Messager = Date & " " & Time & " Login als: " & UserName |
| Messager = Messager & " mit " & CompName & " " & IPAdress |
| Messager = vbCrLf & Messager & vbCrLf & textt |
|
| Print #LogFile, Messager |
| Close #LogFile |
| End Sub |
|
| Function LogFil(compuname, IPAddress) |
| Dim NetzStatus, FiSy As Object, Nett As Object |
| 'Set FiSy = CreateObject("Scripting.FileSystemObject") |
| Set Nett = CreateObject("WScript.Network") |
|
| compuname = Nett.computername |
|
| 'Funktion getIP zum ermitteln der IP-Adresse aufrufen |
| IPAddress = getIP(compuname, IPAddress) |
| NetzStatus = CheckNet(IPAddress) |
| If NetzStatus = "false" Then |
| IPAddress = "Kein Netzwerk vorhanden" |
| End If |
| End Function |
|
| Function getIP(computername, IPAddr) |
| Dim adr As Object |
| Dim obj As Object |
| Dim col As Object |
| Dim x As Variant |
|
| Set obj = GetObject("winmgmts:\\" & computername & "\root\cimv2") |
| Set col = obj.ExecQuery("Select * from Win32_NetworkAdapterConfiguration") |
|
| For Each adr In col |
| x = adr.IPAddress |
| If Not IsNull(adr.IPAddress) Then |
| If Not (adr.IPAddress(0) = "0.0.0.0") Then |
| IPAddr = x(0) |
| End If |
| End If |
| Next |
| getIP = IPAddr |
|
| End Function |
|
| Function CheckNet(IPAdr) |
| If IPAdr = "0.0.0.0" Or IPAdr = "" Then |
| CheckNet = "false" |
| Else |
| CheckNet = "true" |
| End If |
| End Function |
|
| Function GetAdresses(texte) |
| 'Get IE4 History URLs history folder |
| 'This code will open an index.dat file and pull out all sites visited |
| Dim iDisplacement As Integer |
| Dim sURLs(1 To 5000) As String |
| Dim iURLCount As Long |
| Dim sDelimiter As String |
| Dim sData As String |
| Dim IEHistoryFile As String |
| Dim i As Long |
| Dim j As Long |
| Dim x As Integer |
|
| iDisplacement = 104 'old Index.dat = 119 |
| sDelimiter = "URL " '"Visited: " |
| IEHistoryFile = "index.dat" |
| 'For the Index.dat file the delimiter is "URL " |
| 'For other files the delimiter is "Visited: " |
|
| Close #1 'Closes file if already open |
|
| 'Open "C:\Dokumente\Username\UserData\" & IEHistoryFile For Binary As #1 |
| Open IEHistoryFile For Binary As #1 |
|
| sData = Space$(LOF(1)) 'Data Buffer |
| 'sData = String(LOF(1), vbNullChar) |
|
| Get #1, , sData 'Places all data from file into buffer , sData |
| Close #1 'Closes file |
|
| i = InStr(i + 1, sData, sDelimiter) 'Looks for sDelimiter in sData |
| iURLCount = 0 'Sets URLCount to 0 because this is the beginning for the file |
|
| While i < Len(sData) |
| iURLCount = iURLCount + 1 'Keeps a count of how manu URLs are in the file |
| |
| If i > 0 Then |
| ' j = InStr(i + iDisplacement - 1, sData, Chr$(0)) |
| |
| j = InStr(i + iDisplacement, sData, Chr$(0)) |
|
| 'Place URL in an array |
| sURLs(iURLCount) = Mid$(sData, i + iDisplacement, j - (i + iDisplacement)) |
| DoEvents |
| End If |
| |
| i = InStr(i + 1, sData, sDelimiter) 'Index = URL |
| |
| If i = 0 Then GoTo EndURLs 'If there are no more URLs then stop looping |
|
| Wend |
|
| EndURLs: |
| For x = 1 To iURLCount |
| texte = texte & sURLs(x) |
| Next x |
|
| End Function |
|
zurück