Tippseite

VB-Homepage Tipp 111

Ermitteln des aktuell angemeldeten Users

Wenn der PC auf dem Ihr Programm läuft, von mehreren Usern genutzt wird,
dann kann es interessant sein, zu ermitteln, welcher User den gerade
angemeldet ist.
Danach könnten dann an Hand des ermittelten Namens bestimmte Rechte vergeben werden, ohne das in Ihrem Programm ggf. eine eigene Passwortabfrage notwendig ist.
Oder Sie wollen einfach nur sehen, welcher User wie lange angemeldet ist oder oder
...Wie auch immer, wenn Sie also ermitteln wollen, welcher User der Aktuelle ist, dann ist dieser Tipp für Sie genau richtig.

1. Erstellen Sie sich ein neues VB Projekt und fügen diesem ein Label-Objekt hinzu.

2. Fügen Sie in dem Abschnitt
Allgemein/Deklarationen folgendes ein.

Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

3. Fügen Sie nun unter
Form_Load folgendes ein.

Dim RetUserName As Long
Dim lpUserName As String
Dim nSize As Long
Dim RetLastError As Long
Dim RetVal As Long
Dim lpMessageBuffer As String
Dim varia As String

lpUserName = Space(255) 'Buffer vorbereiten.
nSize = Len(lpUserName) 'Länge des Buffers vorbereiten.
RetUserName = GetUserName(lpUserName, nSize) 'UserName abfragen.

If RetUserName <> 0 Then 'UserName ausgeben.
   varia = Left(lpUserName, nSize - 1)
Else 'Username nicht verfügbar.
   RetLastError = GetLastError()
   lpMessageBuffer = Space(255)
   nSize = Len(lpMessageBuffer)
   RetVal = FormatMessage(0, 0, RetLastError, 0, lpMessageBuffer, nSize, 0)
   If RetVal <> 0 Then
      varia = "Fehler " & RetLastError & ": " & lpMessageBuffer
   Else
      varia = "Fehler " & RetLastError & ": kein angemeldeter Benutzer"
   End If
End If

Label1.Caption = UCase(Trim(varia))

4. Starten Sie das Projekt und Ihnen wird im Label-Objekt der aktuelle Username angezeigt.

Tipp-Download

Quelle : MS Knowledge Base