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