VB 获取进程的启动用户

Private Const WTS_CURRENT_SERVER_HANDLE = 0 &
Private Declare Function WTSEnumerateProcesses _
Lib "wtsapi32.dll" Alias "WTSEnumerateProcessesA" _
( ByVal hServer As Long , ByVal Reserved As Long , _
ByVal Version As Long , ByRef ppProcessInfo As Long , _
ByRef pCount As Long ) As Long

Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" ( ByVal lpSystemName As String , ByVal SID As Long , ByVal name As String , cbName As Long , ByVal ReferencedDomainName As String , cbReferencedDomainName As Long , peUse As Long ) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" (pMemory As Any)
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long )

Public Function GetProcessUserNameByProcessId( ByVal dwProcessId As Long ) As String
Dim objWtsProcessInfo As WTS_PROCESS_INFO, i As Integer , lngRet As Long , lngCount As Long
Dim lngInfo As Long , lngAddr As Long , strUserName As String , strDomain As String , lngTmp As Long
lngRet = WTSEnumerateProcesses(WTS_CURRENT_SERVER_HANDLE, 0 , 1 , lngInfo, lngCount)
If lngRet Then
lngAddr = lngInfo
For i = 1 To lngCount
CopyMemory objWtsProcessInfo, ByVal lngAddr, LenB(objWtsProcessInfo)
If objWtsProcessInfo.ProcessID = dwProcessId Then
strUserName = String ( 255 , Chr( 0 ))
strDomain = String ( 255 , Chr( 0 ))
lngRet = LookupAccountSid(vbNullString, objWtsProcessInfo.pUserSid, strUserName, 255 , strDomain, 255 , lngTmp)
GetProcessUserNameByProcessId = Left(strUserName, InStr(strUserName, Chr( 0 )) - 1 )
WTSFreeMemory objWtsProcessInfo
Exit Function
End If
WTSFreeMemory objWtsProcessInfo
lngAddr = lngAddr + LenB(objWtsProcessInfo)
Next
End If
End Function