VBA Tipp: Benutzernamen ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

An einer Datenbank arbeiten mehrere User. In der *.ldb Datei wird lediglich der Computername, aber nicht der angemeldete Benutzer gespeichert. Nun soll herausgefunden werden, welcher Benutzer an diesem Computer angemeldet ist.

Wiki hinweis.png

Voraussetzung:

Dieser Lösungsansatz funktioniert nur in Verbindung mit aktiviertem NetBIOS über TCP/IP Protokoll.


Lösung

Private Type STARTUPINFO
   cb              As Long
   lpReserved      As String
   lpDesktop       As String
   lpTitle         As String
   dwX             As Long
   dwY             As Long
   dwXSize         As Long
   dwYSize         As Long
   dwXCountChars   As Long
   dwYCountChars   As Long
   dwFillAttribute As Long
   dwFlags         As Long
   wShowWindow     As Integer
   cbReserved2     As Integer
   lpReserved2     As Long
   hStdInput       As Long
   hStdOutput      As Long
   hStdError       As Long
End Type
 
Private Type PROCESS_INFORMATION
   hProcess        As Long
   hThread         As Long
   dwProcessID     As Long
   dwThreadID      As Long
End Type
 
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
   ByVal hHandle As Long, _
   ByVal dwMilliseconds As Long) As Long
 
Private Declare Function CreateProcessA Lib "kernel32" ( _
   ByVal lpApplicationName As Long, _
   ByVal lpCommandLine As String, _
   ByVal lpProcessAttributes As Long, _
   ByVal lpThreadAttributes As Long, _
   ByVal bInheritHandles As Long, _
   ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, _
   ByVal lpCurrentDirectory As Long, _
   lpStartupInfo As STARTUPINFO, _
   lpProcessInformation As PROCESS_INFORMATION) As Long
 
Private Declare Function CloseHandle Lib "kernel32" ( _
   ByVal hObject As Long) As Long
 
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
 
Public Sub ExecCmd(CmdLine As String)
   Dim pi     As PROCESS_INFORMATION
   Dim si     As STARTUPINFO
   Dim retVal As Long
 
   'Initialisiert die STARTUPINFO Struktur:
   si.cb = Len(si)
   'Startet die Shell-Anwendung:
   retVal = CreateProcessA(0, CmdLine, 0, 0, 1, NORMAL_PRIORITY_CLASS, 0, 0, si, pi)
   ' Wartet, bis Shell-Anwendung geschlossen ist:
   Do
      retVal = WaitForSingleObject(pi.hProcess, 0)
      DoEvents
   Loop Until retVal <> 258
   retVal = CloseHandle(pi.hProcess)
End Sub
 
Public Sub GetNbtStat(CompName As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim workPath    As String
   Dim InputString As String
   Dim TempString  As String
   Dim fNum        As Integer
   Dim i           As Long
 
   workPath = "C:\Nbtstat\"   ' Muss sich auf C:\Nbtstat\ befinden
 
   If Dir$(workPath & CompName & ".txt") <> vbNullString Then
      Kill workPath & CompName & ".txt"   'Wenn Datei vorhanden, diese löschen
   End If
   ExecCmd workPath & "mynbtstat.bat " & CompName   ' Hier erfolgt Übergabe an BAT-Datei
 
   fNum = FreeFile()
   Open workPath & CompName & ".txt" For Input As #fNum
 
   Do Until EOF(fNum)
      Line Input #fNum, InputString
      If InStr(1, InputString, "<03>") > 0 Then
         If Left$(InputString, 1) <> "C" Then
            i = 1
            TempString = vbNullString
            Do Until Mid$(InputString, i, 1) = " "
               TempString = TempString & Mid$(InputString, i, 1)
               i = i + 1
            Loop
            MsgBox TempString
         End If
      End If
   Loop
 
   If Len(TempString) = 0 Then _
      MsgBox "Kein eindeutiger USER für diesen PC feststellbar", vbCritical
 
   Close fNum
   Kill workPath & CompName & ".txt"
End Sub

Zusätzlich wird noch eine Batchdatei (.bat) benötigt, die im gleichen Verzeichnis liegen muss. Diese sollte ungefähr so aussehen :

@echo off
nbtstat -a %1 >>C:\NBTSTAT\%1.txt

Aufruf

   GetNbtStat Computername


Wiki hinweis.png

Anmerkung:

Wichtig ist auch, auf die Verzeichnisnamen zu achten. Hier würde alles im Verzeichnis C:\NBTSTAT verarbeitet werden.


Benutzername am eigenen Computer

   MsgBox Environ$("USERNAME")

Weblinks