Hallo,

ich suche schon seit längerem in diversen Büchern und natürlich in
allen möglichen Foren eine Möglichkeit, aus einem Dienst heraus
(hierbei handelt es sich um meine VB 6 - Anwendung), der mit dem
lokalen Systemkonto angemeldet ist, den Usernamen des aktuell
angemeldeten Windowsbenutzer (W2k + XP) zu ermitteln.

Der Dienst läuft auf ca. 1.000 Rechnern, die sich in einer Windows
2000 - Domäne befinden und überwacht die angeschlossenen USB-Geräte
aller Clients. Wir haben in einer zentralen Datenbank für alle
Computernamen die erlaubten USB-Geräte hinterlegt. Wird z. B. ein
unerlaubter USB-Stick eingesteckt, wirft ihn der Dienst automatisch
wieder heraus. Das alles funktioniert auch bereits ganz gut.

Nun möchten wir aber die Berechtigung vom Computernamen zu den
Usernamen ändern. Das heißt, wir wollen in der zentralen Datenbank die
Usernamen mit den erlaubten USB-Geräten hinterlegen. Das macht die
ganze Sache flexibler, da sich der Anwender an egal welchem PC
anmelden und seine USB-Geräte benutzen kann. Auch diese Funktion habe
ich bereits umgesetzt und funktioniert auch (fast)...

Jetzt hänge ich aber halt schon längerem an dem Problem, dass ich den
aktuell angemeldeten Windowsbenutzer aus dem Dienst heraus nicht
ermitteln kann. Ich habe diverse Funktionen bereits erfolglos
probiert:

- GetUserName: liefert mir den Benutzer, mit dem der Dienst angemeldet
ist.

- GetEnvironmentVariable("USERNAME", Buffer, l): Umgebungsvariablen
auslesen: Leider hat ein Dienst eigene Umgebungsvariablen und bringt
mich somit nicht weiter.

- Registry "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion
\Explorer" Schlüssel "Logon User Name" auslesen: Im Debug-Modus
liefert mir dieser Schlüssel ganz wunderbar meinen angemeldeten
Usernamen. Wenn die Anwendung als Dienst läuft, wird automatisch auf
folgenden Registrypfad zugegriffen "HKEY_USERS\.DEFAULT\Software
\Microsoft\Windows\CurrentVersion\Explorer" Schlüssel "Logon User
Name". Keine Ahnung warum...

So und jetzt bin ich am Ende mit meinem Latein. Ich hoffe jemand von
euch hat eine Idee.

Viele Grüße
Herbert

hafoer*googlemail.com schrieb:
> ich suche schon seit längerem in diversen Büchern und natürlich in
> allen möglichen Foren eine Möglichkeit, aus einem Dienst heraus
> (hierbei handelt es sich um meine VB 6 - Anwendung), der mit dem
> lokalen Systemkonto angemeldet ist, den Usernamen des aktuell
> angemeldeten Windowsbenutzer (W2k + XP) zu ermitteln.

Wenn Du die historischen W2K Clients nicht hättest, könntest Du das
recht elegant über die WTS API erschlagen, um den Benutzernamen der
gerade aktiven Konsole zu ermitteln.

Seit Windows XP ist die Benutzer-Konsole über die Windows
Terminal Dienste realisiert, egal ob mit oder ohne schnelle
Benutzerumschaltung. Damit Du die Informationen von einem Dienst aus
abfragen kannst, muss dieser Interaktiv mit dem Desktop laufen.
Eventuell reicht es aber auch aus, dem Prozess erweiterte Privilegien
zuzuweisen. Müsste ich aber selber noch einmal genauer schauen:

' --- Deklaration ---
Private Const WTS_CURRENT_SERVER As Long = 0
Private Const WTS_CURRENT_SESSION As Long = -1&

Private Enum WTS_INFO_CLASS
WTSInitialProgram
WTSApplicationName
WTSWorkingDirectory
WTSOEMId
WTSSessionId
WTSUserName
WTSWinStationName
WTSDomainName
WTSConnectState
WTSClientBuildNumber
WTSClientName
WTSClientDirectory
WTSClientProductId
WTSClientHardwareId
WTSClientAddress
WTSClientDisplay
WTSClientProtocolType
End Enum

Private Declare Function WTSGetActiveConsoleSessionId Lib "kernel32.dll" ( _
) As Long
Private Declare Function WTSQuerySessionInformation Lib "wtsapi32.dll" _
Alias "WTSQuerySessionInformationW" ( _
ByVal hServer As Long, _
ByVal SessionID As Long, _
ByVal WTSInfoClass As WTS_INFO_CLASS, _
ByRef ppBuffer As Long, _
ByRef pBytesReturned As Long _
) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" ( _
ByVal pMemory As Long _
)

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
ByRef lpvDest As Any, _
ByRef lpvSource As Any, _
ByVal cbCopy As Long _
)
'
' Anmerkungen:
'
' SessionID = -1
' Bezieht sich immer auf die Konsole unter der die Anwendung
' ausgeführt wird.
' ActiveConsole = True
' Ermittelt die SessionID der gerade aktiven Konsole unabhängig davon,
' in welcher Konsole der Prozess gerade ausgeführt wird.
' "SessionID" wird ignoriert.
Public Function WTSLoggedOnUser(Optional ByVal SessionID As Long = -1, _
Optional ByVal ActiveConsole As Boolean _
) As String
Dim lBufferLen As Long
Dim lBufferPtr As Long
Dim lRet As Long
Dim lUserName As String

If ActiveConsole Then
' Session ID der gerade aktiven Konsole ermitteln:
SessionID = WTSGetActiveConsoleSessionId()
End If

' aktuellen Benutzernamen ermitteln:
lRet = WTSQuerySessionInformation(WTS_CURRENT_SERVER, _
SessionID, WTSUserName, _
lBufferPtr, lBufferLen)

If CBool(lRet) Then
lBufferLen = lBufferLen - 2
lUserName = Space$(lBufferLen / 2)

CopyMemory ByVal StrPtr(lUserName), ByVal lBufferPtr, lBufferLen

WTSFreeMemory lBufferPtr
End If

WTSLoggedOnUser = lUserName
End Function

' --- Anwendung ---
Debug.Print WTSLoggedOnUser(, True)
' ---

Für eine Windows 2000 kompatible Lösung, ist auf jeden Fall
Voraussetzung für das Funktionieren des folgenden Lösungsweges,
dass der Dienst Interaktiv läuft, also Zugriff auf den Desktop des
angemeldeten Benutzers hat. Denn dieser enthält indirekt auch
Informationen zu dem angemeldeten Benutzer in Form eines Token:

' Deklaration:
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hwnd As Long, _
ByRef lpdwProcessId As Long _
) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)

Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long _
) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long _
) As Long

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000

Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or _
SYNCHRONIZE Or &HFFF

Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" ( _
ByVal hHeap As Long, _
ByVal dwFlags As Long, _
ByVal dwBytes As Long _
) As Long
Private Declare Function HeapFree Lib "kernel32" ( _
ByVal hHeap As Long, _
ByVal dwFlags As Long, _
ByRef lpMem As Any _
) As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef TokenHandle As Long _
) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" ( _
ByVal TokenHandle As Long, _
ByVal TokenInformationClass As Long, _
ByRef TokenInformation As Any, _
ByVal TokenInformationLength As Long, _
ByRef ReturnLength As Long_
) As Long

Private Const TOKEN_QUERY = &H8

Private Const TokenUser = 1

Private Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type

Private Type TOKEN_USER
User As SID_AND_ATTRIBUTES
End Type

Private Declare Function LookupAccountSid Lib "advapi32.dll" _
Alias "LookupAccountSidA" ( _
ByVal lpSystemName As String, _
ByVal Sid As Long, _
ByVal Name As String, _
ByRef cbName As Long, _
ByVal ReferencedDomainName As String, _
ByRef cbReferencedDomainName As Long, _
ByRef peUse As Long _
) As Long

Public Function LoggedOnUser(Optional Domain As String) As String
Dim lProgmanWnd As Long
Dim lProgmanPID As Long
Dim lProcess As Long
Dim lToken As Long
Dim lTokenUserLen As Long
Dim lpTokenUser As Long
Dim lTokenUser As TOKEN_USER
Dim lUser As String
Dim lUserLen As Long
Dim lDomain As String
Dim lDomainLen As Long
Dim lUse As Long
Dim lRet As Long

' Ein Fenster des Benutzer finden und den zugehörigen Prozess
' öffnen. "Progman" gehört zum Explorer und ist somit eigentlich
' immer präsent:
lProgmanWnd = FindWindow("Progman", vbNullString)
GetWindowThreadProcessId lProgmanWnd, lProgmanPID

lProcess = OpenProcess(PROCESS_ALL_ACCESS, False, lProgmanPID)

' Prozess Token öffnen. Dieser enthält unter anderem
' Informationen zu dem angemeldeten Benutzer:
If CBool(OpenProcessToken(lProcess, TOKEN_QUERY, lToken)) Then

' Buffer-Größe für das User-Token ermitteln und
' entsprechend großen Buffer reservieren:
GetTokenInformation lToken, TokenUser, ByVal 0, 0, lTokenUserLen
lpTokenUser = HeapAlloc(GetProcessHeap(), 0, lTokenUserLen)

GetTokenInformation lToken, TokenUser, _
ByVal lpTokenUser, _
lTokenUserLen, lTokenUserLen

' Reservierten und gefüllten Buffer in lokale
' TOKEN_USER Struktur umkopieren:
CopyMemory lTokenUser, ByVal lpTokenUser, Len(lTokenUser)

' Benutzer- und Domain-Name können jetzt über die SID
' in Erfahrung gebracht werden. Der erste Aufruf liefert
' wieder die benötigten Buffer-Größen:
lRet = LookupAccountSid(vbNullString, _
lTokenUser.User.Sid, _
lUser, lUserLen, _
lDomain, lDomainLen, _
lUse)

' Buffer vorbereiten und Benutzer-/Domain-Name abfragen:
lUser = Space$(lUserLen - 1)
lDomain = Space$(lDomainLen - 1)

lRet = LookupAccountSid(vbNullString, _
lTokenUser.User.Sid, _
lUser, lUserLen, _
lDomain, lDomainLen, _
lUse)
If CBool(lRet) Then
LoggedOnUser = lUser
Domain = lDomain
End If

' Reservierten Buffer freigeben:
HeapFree GetProcessHeap(), 0, ByVal lpTokenUser

CloseHandle lToken
End If

CloseHandle lProcess
End Function

' Anwendung:
Dim lDomain As String
Dim lUser As String

lUser = LoggedOnUser(lDomain)

Debug.Print "Angemeldeter Benutzer: " & lUser & "*" & lDomain
' ---

Setzt voraus, dass der Explorer als Shell eingesetzt ist (eh Standard,
aber sicherheitshalber). Die Lösung funktioniert wohl auch unter XP, ist
aber zusammen mit FUS mit Vorsicht zu genießen. Unter Vista und Windows
7 habe ich das nie getestet. Da sich hier in Bezug auf interaktive
Dienste und dem Desktopmanager einiges geändert hat, denke ich nicht,
dass es ohne Anpassungen oder überhaupt funktioniert.

Thorsten Dörfler
--
Microsoft MVP Visual Basic

vb-hellfire visual basic faq | vb-hellfire - einfach anders
http://vb-faq.de/ | http://www.vb-hellfire.de/

Hallo Thorsten,

vielen Dank für Deine Hilfe. Das war genau der Hinweis, den ich
gebraucht habe.

Viele Grüße
Herbert