Angemeldeter Benutzer

[Kiffi]

hier die WMI-Variante:

Code: Alles auswählen

IncludePath #PB_Compiler_Home + "srod\comateplus\"
XIncludeFile "comateplus.pbi"

Procedure.s GetUsername(Computer.s)
  
  Protected objWMIService.COMateObject
  Protected objItem.COMateObject 
  Protected colItems.COMateEnumObject 
  
  Protected ReturnValue.s
  
  objWMIService = COMate_GetObject("winmgmts:\\" + Computer + "\root\cimv2", "") 
  
  If objWMIService 
    
    colItems  = objWMIService\CreateEnumeration("ExecQuery('SELECT UserName FROM Win32_ComputerSystem')") 
    
    If colItems  
      
      objItem = colItems\GetNextObject() 
      
      While objItem 
        
        ReturnValue = objItem\GetStringProperty("UserName")
        
        objItem\Release() 
        objItem = colItems\GetNextObject() 
        
      Wend 
      
      colItems\Release() 
      
    EndIf 
    
    objWMIService\Release() 
    
  EndIf 
  
  ProcedureReturn ReturnValue
  
EndProcedure

MessageRequester("Username:", GetUsername("."))

Grüße ... Kiffi

[purebas]

Ich schaue mir die Sache an.

Danke für alle Antworten!

[Shardik]

Ich habe einmal zur Demonstration einen lauffähigen Beispiel-Code erstellt. Ganz
normal in der PB-IDE aufgerufen zeigt er zweimal den angemeldeten Benutzer an.
Wenn man aber in Windows XP unter "Start/Ausführen"

Code: Alles auswählen

RunAs /User:Admin Cmd

eingibt und damit eine Konsole mit Administrator-Rechten startet, dann zeigt es
als angemeldeten Benutzer den Administrator ("Admin" in meinem Beispiel) und als
Aufrufer von RunAs meinen normalen Benutzernamen an:

Code: Alles auswählen

Procedure.S GetWord(WordList.S, Index.I)
  Protected WordStart.I = #True
  Protected WordCount.I
  
  If Index > 0 And WordList <> ""
    For i = 1 To Len(WordList)
      If Mid(WordList, i, 1) = " "
        WordStart = #True
      Else
        If WordStart
          WordCount + 1
          WordStart = #False
          
          If Index = WordCount
            ProcedureReturn StringField(Mid(WordList, i), 1, " ")
          EndIf
        EndIf
      EndIf
    Next i
  EndIf
EndProcedure

ComputerName$ = GetEnvironmentVariable("COMPUTERNAME")
UserName$ = GetEnvironmentVariable("USERNAME")
ProgramID = RunProgram("QWINSTA.EXE", "console /SERVER:" + ComputerName$, "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
Output$ = ""

If ProgramID  
  While ProgramRunning(ProgramID)
    If AvailableProgramOutput(ProgramID)
      Output$ + ReadProgramString(ProgramID)
    EndIf
  Wend
   
  CloseProgram(ProgramID)
EndIf

Info$ = "Dieses Programm läuft mit den Rechten von User-ID " + UserName$ + #CR$
Info$ + "Wurde es mit RunAs aufgerufen, dann von User-ID " + GetWord(Output$, 8)

MessageRequester("Info", Info$, #MB_ICONINFORMATION)

Wenn Du auch noch ein deutlich längeres Beispiel benötigst, das auch noch den zum
RunAs-Aufrufer passenden Registryzweig unter HKEY_USERS ausgibt, dann gib mir bitte
hier Bescheid...

[purebas]

@Shardik

Ja! Ein Beispiel mit dem passenden Registryzweig unter HKEY_USERS wäre echt toll.
Ich bin nämlich Anfänger pur(e).

[Shardik]

Ja! Ein Beispiel mit dem passenden Registryzweig unter HKEY_USERS wäre echt toll.

Aber gerne doch:

Code: Alles auswählen

EnableExplicit

#REG_ERROR_BADDB = 1 
#REG_ERROR_BADKEY = 2 
#REG_ERROR_CANTOPEN = 3 
#REG_ERROR_CANTREAD = 4 
#REG_ERROR_CANTWRITE = 5 
#REG_ERROR_OUTOFMEMORY = 6 
#REG_ERROR_INVALID_PARAMETER = 7 
#REG_ERROR_ACCESS_DENIED = 8 
#REG_ERROR_INVALID_PARAMETERS = 87 

Procedure.S GetWinAPIErrorMsg(ErrorCode.I)
  Protected ErrorMsg.S
  Protected ErrorMsgBuffer.S
  Protected ErrorMsgLength.I
  Protected FormatTextError.I
  Protected ModuleHandle.I

  Select ErrorCode 
    Case #REG_ERROR_BADDB
      ErrorMsg = "Beim Registry-Zugriff ist ein Datenbank-Fehler aufgetreten"
    Case #REG_ERROR_BADKEY
      ErrorMsg = "Beim Registry-Zugriff wurde ein fehlerhafter Schlüsselname oder Pfad verwendet"
    Case #REG_ERROR_CANTOPEN
      ErrorMsg = "Die Registry konnte nicht geöffnet werden"
    Case #REG_ERROR_CANTREAD
      ErrorMsg = "Die Registry konnte nicht gelesen werden"
    Case #REG_ERROR_CANTWRITE
      ErrorMsg = "Das Schreiben in die Registry ist gescheitert"
    Case #REG_ERROR_OUTOFMEMORY
      ErrorMsg = "Fehlender Speicher bei Registry-Zugriff"
    Case #REG_ERROR_INVALID_PARAMETER
      ErrorMsg = "Beim Registry-Zugriff wurde ein ungültiger Parameter angegeben"
    Case #REG_ERROR_ACCESS_DENIED
      ErrorMsg = "Fehlende Autorisierung beim Zugriff auf die Registry"
    Case #REG_ERROR_INVALID_PARAMETERS
      ErrorMsg = "Beim Registry-Zugriff wurden ungültige Parameter angegeben"
    Default
      ErrorMsgBuffer = Space(255)
      ErrorMsgLength = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, ErrorCode, GetUserDefaultLangID_(), @ErrorMsgBuffer, Len(ErrorMsgBuffer), 0)

      If ErrorMsgLength = 0
        FormatTextError = #True
        ErrorMsg = "Die Textumsetzung dieses Windows-Fehlercodes mit der Windows-Funktion FormatMessage() ist gescheitert!"
      Else
        ErrorMsg = Left(ErrorMsgBuffer, ErrorMsgLength)
      EndIf
    EndSelect

    If FormatTextError = #False
      ErrorMsg = "Windows-Fehlernummer " + Str(ErrorCode) + ": " + #CR$ + ErrorMsg + "!"
    EndIf

  ProcedureReturn ErrorMsg
EndProcedure

Procedure.S ReadRegistrySubKey(RootKey.I, SubKeyPath.S, Index.I)
  Protected ErrorCode.I
  Protected LastTimeKeyWritten.I
  Protected KeyHandle.I
  Protected KeyType.I
  Protected KeyContent.S
  Protected SubKeyName.S
  Protected SubKeyNameLength.I

  ErrorCode = RegOpenKeyEx_(RootKey, SubKeyPath, 0, #KEY_ENUMERATE_SUB_KEYS, @KeyHandle)

  If ErrorCode <> #ERROR_SUCCESS
    MessageRequester("Fehler", GetWinAPIErrorMsg(ErrorCode), #MB_ICONERROR)
  Else  
    SubKeyName = Space(255) 
    SubKeyNameLength = Len(SubKeyName) + 1
                    
    ErrorCode = RegEnumKeyEx_(KeyHandle, Index, @SubKeyName, @SubKeyNameLength, 0, 0, 0, @LastTimeKeyWritten) 
 
    If ErrorCode <> #ERROR_SUCCESS
      If ErrorCode <> #ERROR_NO_MORE_ITEMS
        MessageRequester("Fehler", GetWinAPIErrorMsg(ErrorCode), #MB_ICONERROR)
      EndIf
    Else
      SubKeyName = Left(SubKeyName, SubKeyNameLength) 
    EndIf
 
    RegCloseKey_(KeyHandle)
  EndIf

  ProcedureReturn Trim(SubKeyName)
EndProcedure

Procedure.S ReadRegistryKey(RootKey.I, SubKeyPath.S, ValueName.S)
  Protected Buffer.S
  Protected BufferSize.I
  Protected ErrorCode.I
  Protected KeyHandle.I
  Protected KeyType.I
  Protected KeyContent.S
  Protected NullPos.I

  ErrorCode = RegOpenKeyEx_(RootKey, SubKeyPath, 0, #KEY_QUERY_VALUE, @KeyHandle)
  
  If ErrorCode <> #ERROR_SUCCESS
    MessageRequester("Fehler", GetWinAPIErrorMsg(ErrorCode), #MB_ICONERROR)
  Else  
    ErrorCode = RegQueryValueEx_(KeyHandle, ValueName, 0, @KeyType, 0, @BufferSize)
    
    If ErrorCode <> #ERROR_SUCCESS
      If ErrorCode <> #REG_ERROR_BADKEY
        MessageRequester("Fehler", GetWinAPIErrorMsg(ErrorCode), #MB_ICONERROR)
      EndIf
    Else
      Buffer = Space(BufferSize)

      Select KeyType
        Case #REG_SZ, #REG_EXPAND_SZ
          ErrorCode = RegQueryValueEx_(KeyHandle, ValueName, 0, @KeyType, @Buffer, @BufferSize)
          
          If ErrorCode <> #ERROR_SUCCESS
            MessageRequester("Fehler", GetWinAPIErrorMsg(ErrorCode), #MB_ICONERROR)
          Else
            KeyContent = Buffer 
          EndIf 
        Case #REG_DWORD 
          If RegQueryValueEx_(KeyHandle, ValueName, 0, @KeyType, @Buffer, @BufferSize) <> #ERROR_SUCCESS
            KeyContent = "0" 
          Else 
            KeyContent = StrU(PeekL(@Buffer), #PB_Long) 
          EndIf 
        Case #REG_MULTI_SZ 
          If RegQueryValueEx_(KeyHandle, ValueName, 0, @KeyType, @Buffer, @BufferSize) <> #ERROR_SUCCESS
            MessageRequester("Fehler", GetWinAPIErrorMsg(ErrorCode), #MB_ICONERROR)
          Else
            Repeat
              KeyContent = KeyContent + PeekS(@Buffer + NullPos) + #CR$
              NullPos = Len(KeyContent) + NullPos + 1
            Until NullPos = BufferSize

            KeyContent = Left(KeyContent, Len(KeyContent) - 1)
          EndIf
      EndSelect
    EndIf
  EndIf

  RegCloseKey_(KeyHandle)

  ProcedureReturn KeyContent
EndProcedure

Procedure.S GetWord(WordList.S, Index.I)
  Protected i.I
  Protected WordStart.I = #True
  Protected WordCount.I
 
  If Index > 0 And WordList <> ""
    For i = 1 To Len(WordList)
      If Mid(WordList, i, 1) = " "
        WordStart = #True
      Else
        If WordStart
          WordCount + 1
          WordStart = #False
         
          If Index = WordCount
            ProcedureReturn StringField(Mid(WordList, i), 1, " ")
          EndIf
        EndIf
      EndIf
    Next i
  EndIf
EndProcedure

Define ComputerName.S
Define KeyContent.S
Define Info.S
Define Output.S
Define ProgramID.I
Define RootKey.I
Define RunAsCaller.S
Define SubKeyIndex.I
Define SubKeyName.S
Define SubKeyPath.S
Define UserID.S
Define ValueName.S

; ----- Ermitteln, wer dieses Programm eventuell mit RunAs aufgerufen hat

ComputerName = GetEnvironmentVariable("COMPUTERNAME")
UserID = GetEnvironmentVariable("USERNAME")
ProgramID = RunProgram("QWINSTA.EXE", "console /SERVER:" + ComputerName, "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
Output = ""

If ProgramID 
  While ProgramRunning(ProgramID)
    If AvailableProgramOutput(ProgramID)
      Output + ReadProgramString(ProgramID)
    EndIf
  Wend
   
  CloseProgram(ProgramID)
EndIf

RunAsCaller = GetWord(Output, 8)

; ----- Registry-Zweig in HKEY_USERS ermitteln, in dem die User-ID definiert ist

RootKey = #HKEY_LOCAL_MACHINE
SubKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
ValueName = "ProfileImagePath"

Repeat
  SubKeyName = ReadRegistrySubKey(RootKey, SubKeyPath, SubKeyIndex)

  If SubKeyName <> ""
    SubKeyIndex + 1
    KeyContent = ReadRegistryKey(RootKey, SubKeyPath + "\" + SubKeyName, ValueName)
    
    If UCase(RunAsCaller) = UCase(StringField(KeyContent, CountString(KeyContent, "\") + 1, "\"))
      Break
    EndIf
    
    If KeyContent = ""
      MessageRequester("Fehler", "Im Registry-Zweig " + #CR$ + "HKLM\" + SubKeyPath + "\" + SubKeyName + #CR$ + "ist kein ProfileImagePath-Eintrag vorhanden!", #MB_ICONERROR)
      End  
    EndIf
  EndIf
Until SubKeyName = ""

If SubKeyName = ""
  MessageRequester("Fehler", "Die User-ID " + UserID + " konnte im Registry-Zweig " + #CR$ + "HKLM\" + SubKeyPath + #CR$ + "nicht gefunden werden!", #MB_ICONERROR)
  End
EndIf

Info = "Dieses Programm läuft mit den Rechten von User-ID " + UserID + "." + #CR$
Info + "Wurde es mit RunAs aufgerufen, dann von User-ID " + GetWord(Output, 8) +  "." + #CR$
Info + "Diese User-ID ist unter HKEY_USERS in folgendem Registry-Zweig definiert:" + #CR$ + "HKEY_USERS\" + SubKeyName

MessageRequester("Info", Info, #MB_ICONINFORMATION)

Ich habe dieses Beispiel in Windows XP Professional SP3 und Windows 7 Enterprise getestet,
obwohl es in Vista oder Windows 7 nicht mehr ganz so viel Sinn macht, da man ja ein Programm
nach Rechtsklick direkt mit der Option "Als Administator ausführen" starten kann und dies
dann über Anhebung der Rechte des normalen Anwenders funktioniert, sodaß die beiden
User-IDs in diesem Fall dann sowieso gleich sind. Aber das Ergebnis ist natürlich trotzdem
korrekt...

[Kiffi]

@purebas: ein Feedback zu meinem Code wäre auch nett.

[purebas]

Sorry, dass mein Feedback solange gebraucht hat. (Künstlerpause)

Dein Code hat mich schon gut weitergebracht. Wobei es noch einen Fehler gibt.

Unter "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList" gibt es keinen "ProfileImagePath".
Vorher kommen noch die kryptischen Schlüssel wie bspw. "S-1-5-21-3026663911-1875951597-1305847501-1002".

Dein Programm zeigt folgerichtig (wenn auch falsch) die Meldung:

Die User-ID <xyz> konnte im Registry-Zweig
HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList
nicht gefunden werden!

[Shardik]

@purebas: ein Feedback zu meinem Code wäre auch nett.

Sorry, dass mein Feedback solange gebraucht hat. (Künstlerpause)

Dein Code hat mich schon gut weitergebracht. Wobei es noch einen Fehler gibt.

Der Feedback-Wunsch stammte übrigens von Kiffi, der gerne wüßte, ob er Dir mit seinem
WMI-Beispiel weiterhelfen konnte...

Unter "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList" gibt es keinen "ProfileImagePath".

Das ist auch korrekt so. Leider enthält die Fehlermeldung fälschlicherweise nicht den
kompletten Pfad. Die Repeat...Until-Schleife durchsucht alle "kryptischen" Unterschlüssel
im Schlüssel "ProfileList". Und die sollten alle den Schlüssel "ProfileImagePath" enthalten.
Die korrekte Fehlermeldung sollte also hinter dem oben genannten Pfad noch den Namen
des "kryptischen" Unterschlüssels enthalten, indem sie noch zusätzlich den Inhalt von
SubKeyName anhängt:

Code: Alles auswählen

      MessageRequester("Fehler", "Im Registry-Zweig " + #CR$ + "HKLM\" + SubKeyPath + "\" + SubKeyName + #CR$ + "ist kein ProfileImagePath-Eintrag vorhanden!", #MB_ICONERROR)

Ich habe das obige Code-Beispiel daher korrigiert.

Dies wird aber wahrscheinlich Dein Problem nicht lösen. Du solltest unbedingt Deine
Windows-Version angeben. Setzt Du eine 64 Bit Version ein? Dann kann ich Dir leider
mangels Testmöglichkeit nicht weiterhelfen...

Mit diesen Windows-Versionen habe ich das letzte Beispiel erfolgreich getestet:
Windows XP Home SP2 32 Bit
Windows XP Professional SP3 32 Bit
Windows 7 Enterprise 32 Bit

[Renovatio]

hol dir dann mal psloggedon.exe von den ps-tools von http://www.sysinternals.com (Microsoft)

da mehrere User angemeldet gleichzeitig sein können, gibt es wohl keine ganz einfache Lösung
wie 'aus der Registry lesen' oder so.

aus der psloggedonhilfe

PsLoggedOn's definition of a locally logged on user is one that has their profile loaded into the Registry, so PsLoggedOn determines who is logged on by scanning the keys under the HKEY_USERS key. For each key that has a name that is a user SID (security Identifier), PsLoggedOn looks up the corresponding user name and displays it. To determine who is logged onto a computer via resource shares, PsLoggedOn uses the NetSessionEnum API. Note that PsLoggedOn will show you as logged on via resource share to remote computers that you query because a logon is required for PsLoggedOn to access the Registry of a remote system.

Wie wäre es mit so einem Ansatz:

Username und aktiver Username auslesen.
Somit wäre egal wie viele gerade eingeloggt sind, weil an einem PC (ausgegangen von einer Tastatur und einer Maus) für gewöhnlich nur einer arbeiten kann.

In einem Prog für eine Firma welches ich mal geproggt habe, habe ich für den aktuellen Nutzer dies hier verwendet:

Code: Alles auswählen

Procedure check_user()
If UserHome$ = UserDoc$+"DeinBenutzername\" Or UserHome$ = UserDoc$+"DeinUsername.DOMAIN\"
	ActUser$ = "Ausgegebener Username"
	WinUser$+" "+ActUser$
Else
	ActUser$ = GetEnvironmentVariable("USERNAME")
	WinUser$ = "Benutzer: "+ActUser$
EndIf
EndProcedure

Viele Grüße