Start Time, Run Duration & location of application by PID in Windows - windows

Is there any Way to get Start Time(with date), total running time and location of a running application using its PID value under windows by using CMD or VBS? If so, how? thanks in advance.

You can query the Win32_Process WMI class with a VBScript to get the executable path and the start time of a process. The duration can be derived from the start time:
pid = 23
Set wmi = GetObject("winmgmts://./root/cimv2")
Set convert = CreateObject("WbemScripting.SWbemDateTime")
qry = "SELECT * FROM Win32_Process WHERE ProcessId = " & pid
For Each p In wmi.ExecQuery(qry)
If IsNull(p.CreationDate) Then
'leave start time and duration empty if CreationDate can't be read
startTime = ""
duration = ""
Else
'convert start time from a string yyyyMMddHHmmss.ffffff±zzz to a date
convert.Value = p.CreationDate
startTime = convert.GetVarDate(True)
'calculate duration in minutes
duration = DateDiff("n", startTime, Now)
End If
WScript.Echo startTime & vbTab & duration & vbTab & p.ExecutablePath
Next
Note that you need the SeDebugPrivilege privilege (administrators have it by default) to be able to see the executable path of the processes of other users. Without that privilege p.ExecutablePath will be Null for processes not running in the context of the current user.

Not as such (for time - path's available).
You can monitor process starts and exits and calculate it yourself.
So Tasklist /v gives you the command line which includes the path.
The same thing in VBS.
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
msgbox objItem.ProcessID & " " & objItem.Caption
Next
This is a VBS script that monitors process starts and exits.
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set objEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM Win32_ProcessTrace")
Do
Set objReceivedEvent = objEvents.NextEvent
msgbox objReceivedEvent.ProcessName
Loop
No such thing as StartTime
class Win32_Process : CIM_Process
{
string Caption;
string CommandLine;
string CreationClassName;
datetime CreationDate;
string CSCreationClassName;
string CSName;
string Description;
string ExecutablePath;
uint16 ExecutionState;
string Handle;
uint32 HandleCount;
datetime InstallDate;
uint64 KernelModeTime;
uint32 MaximumWorkingSetSize;
uint32 MinimumWorkingSetSize;
string Name;
string OSCreationClassName;
string OSName;
uint64 OtherOperationCount;
uint64 OtherTransferCount;
uint32 PageFaults;
uint32 PageFileUsage;
uint32 ParentProcessId;
uint32 PeakPageFileUsage;
uint64 PeakVirtualSize;
uint32 PeakWorkingSetSize;
uint32 Priority;
uint64 PrivatePageCount;
uint32 ProcessId;
uint32 QuotaNonPagedPoolUsage;
uint32 QuotaPagedPoolUsage;
uint32 QuotaPeakNonPagedPoolUsage;
uint32 QuotaPeakPagedPoolUsage;
uint64 ReadOperationCount;
uint64 ReadTransferCount;
uint32 SessionId;
string Status;
datetime TerminationDate;
uint32 ThreadCount;
uint64 UserModeTime;
uint64 VirtualSize;
string WindowsVersion;
uint64 WorkingSetSize;
uint64 WriteOperationCount;
uint64 WriteTransferCount;
};

Related

Is it possible to successfully get results when running PsExec in MS Access using Shell.Exec()?

I'm trying to get the disk status of few servers using PSEXEC for the command in shell and append it to the table. But I only get the caption from the shell result.
here is my code:
Option Compare Database
Option Explicit
Const svrUname = "username"
Const svrPass = "password"
Const ForReading = 1
Sub First()
Dim svr(2, 1) As String
svr(0, 0) = ""
svr(0, 1) = "server name"
svr(1, 0) = "PSEXEC \\(IPADD) -u " & svrUname & " -p " & svrPass "
svr(1, 1) = ""
Dim i As Integer
For i = 0 To 1
Call ShellRun(svr(i, 0) & "WMIC logicaldisk get size, caption, " _
& "freespace", svr(i, 1))
Next
End Sub
Public Sub ShellRun(sCmd As String, svrName As String)
' Run a shell command, returning the output as a string
Dim oShell As Object
Dim oExec As Object
Dim oOutput As Object
Dim a As String
' Run command
Set oShell = CreateObject("Wscript.Shell")
Set oExec = oShell.Exec(sCmd)
Set oOutput = oExec.StdOut
' handle the results as they are written to and read from the StdOut object
Dim sInfo As String
Dim sLine As String
While Not oOutput.AtEndofStream
sLine = oOutput.Readline
Call EXTRACTINFO(sLine, svrName)
a = a & sLine
SKIP:
Wend
MsgBox a
oExec.Terminate
End Sub
and the result is only like this 
I was hoping to get these results when run from MS access
What seems to be the problem?
If I run this code:
Sub First()
Const svrUname = "username"
Const svrPass = "password"
Const ForReading = 1
Dim svr(2, 1) As String
svr(0, 0) = ""
svr(0, 1) = "server name"
svr(1, 0) = "PSEXEC \\(IPADD) -u " & svrUname & " -p " & svrPass
svr(1, 1) = ""
Dim i As Integer
For i = 0 To 0
Call ShellRun(svr(i, 0) & "WMIC logicaldisk get size, caption, " _
& "freespace", svr(i, 1))
Next
End Sub
Public Sub ShellRun(sCmd As String, svrName As String)
' Run a shell command, returning the output as a string
Dim oShell As Object
Dim oExec As Object
Dim oOutput As Object
Dim a As String
' Run command
Set oShell = CreateObject("Wscript.Shell")
Set oExec = oShell.Exec(sCmd)
Set oOutput = oExec.StdOut
' handle the results as they are written to and read from the StdOut object
Dim sInfo As String
Dim sLine As String
While Not oOutput.AtEndofStream
sLine = oOutput.Readline
'Call EXTRACTINFO(sLine, svrName)
a = a & sLine
SKIP:
Wend
MsgBox a
oExec.Terminate
End Sub
it returns:
So double-check your EXTRACTINFO function.
Command file:
C:\Folder\PsExec \\server -u user -p password WMIC logicaldisk get size, caption, freespace > C:\SomeFolder\DiskSize.txt
Then read this file.

hresult 0x800a01b6 on seccond pass

I get an hresult 0x800a01b6 on the seccond passing of my code.
When it runs the first time it works but fails seccond time around. IE opens then program stops.
Dim pID As String
Dim mesg As String
Dim pw As String
Dim Id As String
Dim ie As Object
Dim l As String
'For Each Id In ListBox2.Items'
For i As Integer = 0 To Me.ListBox2.Items.Count - 1
Id = Me.ListBox2.Items(i).ToString
If Id = "me " Then
Id = "466901"
ElseIf "you" Then
Id = "466942"
End If
ie = CreateObject("InternetExplorer.Application")
ie.Navigate("http://www.webpage.com.au/")
ie.Visible = True
mesg = TextBox1.Text.ToString()
pw = "....."
ie.Document.All("password").Value = pw
ie.Document.All("idpagers").Value = Id
ie.Document.All("message").Value = mesg
ie.Document.All("Send").Click()
pID = ie.Document.All().ToString
'MessageBox.Show(pID)
MessageBox.Show(l & mesg & pw, "Test")'
Next
End Sub

How to check if command prompt is open using VB Script?

How to check if command prompt/window is open using VB Script?
I am using Visual Studio 2010 - Setup Project, and I want my VB Script to check if the command line is closed, and when it's closed, it will raise an error and terminate the whole installation.
class Win32_ProcessStartTrace : Win32_ProcessTrace
{
uint4 PageDirectoryBase;
string ParentProcessName;
uint32 ProcessID;
string ProcessName;
uint8 SECURITY_DESCRIPTOR[];
uint32 SessionID;
uint8 Sid[];
uint8 TIME_CREATED;
};
This monitors starts and stops. Above properties is from starts only and same properties as below object. Also there is a stop object. My code can only do one event, there's an alternative that can do multi events but you have to set up event handlers.
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set objEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM Win32_ProcessTrace")
Do
Set objReceivedEvent = objEvents.NextEvent
msgbox objReceivedEvent.ProcessName
Loop
You can get extra info from the Process class.
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
'Get process id you want from other script
If obj.ProcessID = 1004 Then
msgbox objItem.ProcessID & " " & FormatDateTime(CDate(objItem.CreationDate))
EndIf
Next
These are it's properties. It also has methods.
class Win32_Process : CIM_Process
{
string Caption;
string CommandLine;
string CreationClassName;
datetime CreationDate;
string CSCreationClassName;
string CSName;
string Description;
string ExecutablePath;
uint16 ExecutionState;
string Handle;
uint32 HandleCount;
datetime InstallDate;
uint64 KernelModeTime;
uint32 MaximumWorkingSetSize;
uint32 MinimumWorkingSetSize;
string Name;
string OSCreationClassName;
string OSName;
uint64 OtherOperationCount;
uint64 OtherTransferCount;
uint32 PageFaults;
uint32 PageFileUsage;
uint32 ParentProcessId;
uint32 PeakPageFileUsage;
uint64 PeakVirtualSize;
uint32 PeakWorkingSetSize;
uint32 Priority;
uint64 PrivatePageCount;
uint32 ProcessId;
uint32 QuotaNonPagedPoolUsage;
uint32 QuotaPagedPoolUsage;
uint32 QuotaPeakNonPagedPoolUsage;
uint32 QuotaPeakPagedPoolUsage;
uint64 ReadOperationCount;
uint64 ReadTransferCount;
uint32 SessionId;
string Status;
datetime TerminationDate;
uint32 ThreadCount;
uint64 UserModeTime;
uint64 VirtualSize;
string WindowsVersion;
uint64 WorkingSetSize;
uint64 WriteOperationCount;
uint64 WriteTransferCount;
};
Her's a sample script from Help showing how to do multiple events handlers.
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & _
strComputer & "\root\CIMV2")
Set EventSink = WScript.CreateObject( _
"WbemScripting.SWbemSink","SINK_")
objWMIservice.ExecNotificationQueryAsync EventSink, _
"SELECT * FROM Win32_ProcessTrace WITHIN 10"
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Sub SINK_OnObjectReady(objObject, objAsyncContext)
Wscript.Echo "Win32_ProcessTrace event has occurred."
i = i+1
If i = 3 Then WScript.Quit 0
End Sub

Visual Basic: Adding users and group

I'm updating an installer and need to create a Windows group and add (existing) users to that group.
The users are IIS pseudo-users, ie IIS APPPOOL\username
Is there a simple way to do this using VB6 or VB.NET? I can't find an obvious library/API or any example code
Thanks
You can try the following code extracted from this link to create users. Basically it uses the API NetUserAdd.
Option Explicit
' ---------------------------------------------
' The USER_INFO_3 data structure
' ---------------------------------------------
Private Type USER_INFO_3
usri3_name As Long
usri3_password As Long
usri3_password_age As Long
usri3_priv As Long
usri3_home_dir As Long
usri3_comment As Long
usri3_flags As Long
usri3_script_path As Long
usri3_auth_flags As Long
usri3_full_name As Long
usri3_usr_comment As Long
usri3_parms As Long
usri3_workstations As Long
usri3_last_logon As Long
usri3_last_logoff As Long
usri3_acct_expires As Long
usri3_max_storage As Long
usri3_units_per_week As Long
usri3_logon_hours As Long
usri3_bad_pw_count As Long
usri3_num_logons As Long
usri3_logon_server As Long
usri3_country_code As Long
usri3_code_page As Long
usri3_user_id As Long
usri3_primary_group_id As Long
usri3_profile As Long
usri3_home_dir_drive As Long
usri3_password_expired As Long
End Type
' ---------------------------------------------
' Possible errors with API call
' ---------------------------------------------
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const NERR_BASE As Long = 2100
Private Const NERR_GroupExists As Long = NERR_BASE + 123
Private Const NERR_NotPrimary As Long = NERR_BASE + 126
Private Const NERR_UserExists As Long = NERR_BASE + 124
Private Const NERR_PasswordTooShort As Long = NERR_BASE + 145
Private Const NERR_InvalidComputer As Long = NERR_BASE + 251
Private Const NERR_Success As Long = 0&
Private Const TIMEQ_FOREVER As Long = -1&
Private Const DOMAIN_GROUP_RID_USERS As Long = &H201&
Private Const USER_MAXSTORAGE_UNLIMITED As Long = -1&
Private Const constUserInfoLevel3 As Long = 3
' ---------------------------------------------
' Used by usri3_flags element of data structure
' ---------------------------------------------
Private Const UF_SCRIPT As Long = &H1&
Private Const UF_ACCOUNTDISABLE As Long = &H2&
Private Const UF_HOMEDIR_REQUIRED As Long = &H8&
Private Const UF_LOCKOUT As Long = &H10&
Private Const UF_PASSWD_NOTREQD As Long = &H20&
Private Const UF_PASSWD_CANT_CHANGE As Long = &H40&
Private Const UF_DONT_EXPIRE_PASSWD As Long = &H10000
Private Const STILL_ACTIVE As Long = &H103&
Private Const UF_NORMAL_ACCOUNT As Long = &H200&
Private Const UF_SERVER_TRUST_ACCOUNT As Long = &H2000&
Private Const PROCESS_QUERY_INFORMATION As Long = &H400&
Private Const UF_TEMP_DUPLICATE_ACCOUNT As Long = &H100&
Private Const UF_INTERDOMAIN_TRUST_ACCOUNT As Long = &H800&
Private Const UF_WORKSTATION_TRUST_ACCOUNT As Long = &H1000&
Private Declare Function NetUserAdd Lib "netapi32.dll" (ServerName As Byte, ByVal Level As Long, Buffer As USER_INFO_3, parm_err As Long) As Long
Private Declare Function NetApiBufferAllocate Lib "netapi32.dll" (ByVal ByteCount As Long, Ptr As Long) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32" (ByVal pBuffer As Long) As Long
' *******************************************************
' Add a user either to NT -- you *MUST* have admin or
' account operator privileges to successfully run
' this function
' Use on NT Only
' *******************************************************
Public Function AddUser(ByVal xi_strServerName As String, _
ByVal xi_strUserName As String, _
ByVal xi_strPassword As String, _
Optional ByVal xi_strUserFullName As String = vbNullString, _
Optional ByVal xi_strUserComment As String = vbNullString) As Boolean
Dim p_strErr As String
Dim p_lngRtn As Long
Dim p_lngPtrUserName As Long
Dim p_lngPtrPassword As Long
Dim p_lngPtrUserFullName As Long
Dim p_lngPtrUserComment As Long
Dim p_lngParameterErr As Long
Dim p_lngFlags As Long
Dim p_abytServerName() As Byte
Dim p_abytUserName() As Byte
Dim p_abytPassword() As Byte
Dim p_abytUserFullName() As Byte
Dim p_abytUserComment() As Byte
Dim p_typUserInfo3 As USER_INFO_3
If xi_strUserFullName = vbNullString Then
xi_strUserName = xi_strUserName
End If
' ------------------------------------------
' Create byte arrays to avoid Unicode hassles
' ------------------------------------------
p_abytServerName = xi_strServerName & vbNullChar
p_abytUserName = xi_strUserName & vbNullChar
p_abytUserFullName = xi_strUserFullName & vbNullChar
p_abytPassword = xi_strPassword & vbNullChar
p_abytUserComment = xi_strUserComment & vbNullChar
' ------------------------------------------
' Allocate buffer space
' ------------------------------------------
p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserName), p_lngPtrUserName)
p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserFullName), p_lngPtrUserFullName)
p_lngRtn = NetApiBufferAllocate(UBound(p_abytPassword), p_lngPtrPassword)
p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserComment), p_lngPtrUserComment)
' ------------------------------------------
' Get pointers to the byte arrays
' ------------------------------------------
p_lngPtrUserName = VarPtr(p_abytUserName(0))
p_lngPtrUserFullName = VarPtr(p_abytUserFullName(0))
p_lngPtrPassword = VarPtr(p_abytPassword(0))
p_lngPtrUserComment = VarPtr(p_abytUserComment(0))
' ------------------------------------------
' Fill the VB structure
' ------------------------------------------
p_lngFlags = UF_NORMAL_ACCOUNT Or UF_SCRIPT Or UF_DONT_EXPIRE_PASSWD
With p_typUserInfo3
.usri3_acct_expires = TIMEQ_FOREVER ' Never expires
.usri3_comment = p_lngPtrUserComment ' Comment
.usri3_flags = p_lngFlags ' There are a number of variations
.usri3_full_name = p_lngPtrUserFullName ' User's full name
.usri3_max_storage = USER_MAXSTORAGE_UNLIMITED ' Can use any amount of disk space
.usri3_name = p_lngPtrUserName ' Name of user account
.usri3_password = p_lngPtrPassword ' Password for user account
.usri3_primary_group_id = DOMAIN_GROUP_RID_USERS ' You MUST use this constant for NetUserAdd
.usri3_script_path = 0& ' Path of user's logon script
.usri3_auth_flags = 0& ' Ignored by NetUserAdd
.usri3_bad_pw_count = 0& ' Ignored by NetUserAdd
.usri3_code_page = 0& ' Code page for user's language
.usri3_country_code = 0& ' Country code for user's language
.usri3_home_dir = 0& ' Can specify path of home directory of this user
.usri3_home_dir_drive = 0& ' Drive letter assign to user's profile
.usri3_last_logoff = 0& ' Not needed when adding a user
.usri3_last_logon = 0& ' Ignored by NetUserAdd
.usri3_logon_hours = 0& ' Null means no restrictions
.usri3_logon_server = 0& ' Null means logon to domain server
.usri3_num_logons = 0& ' Ignored by NetUserAdd
.usri3_parms = 0& ' Used by specific applications
.usri3_password_age = 0& ' Ignored by NetUserAdd
.usri3_password_expired = 0& ' None-zero means user must change password at next logon
.usri3_priv = 0& ' Ignored by NetUserAdd
.usri3_profile = 0& ' Path to a user's profile
.usri3_units_per_week = 0& ' Ignored by NetUserAdd
.usri3_user_id = 0& ' Ignored by NetUserAdd
.usri3_usr_comment = 0& ' User comment
.usri3_workstations = 0& ' Workstations a user can log onto (null = all stations)
End With
' ------------------------------------------
' Attempt to add the user
' ------------------------------------------
p_lngRtn = NetUserAdd(p_abytServerName(0), _
constUserInfoLevel3, _
p_typUserInfo3, _
p_lngParameterErr)
' ------------------------------------------
' Check for error
' ------------------------------------------
If p_lngRtn <> 0 Then
AddUser = False
Select Case p_lngRtn
Case ERROR_ACCESS_DENIED
p_strErr = "User doesn't have sufficient access rights."
Case NERR_GroupExists
p_strErr = "The group already exists."
Case NERR_NotPrimary
p_strErr = "Can only do this operation on the PDC of the domain."
Case NERR_UserExists
p_strErr = "The user account already exists."
Case NERR_PasswordTooShort
p_strErr = "The password is shorter than required."
Case NERR_InvalidComputer
p_strErr = "The computer name is invalid."
Case Else
p_strErr = "Unknown error #" & CStr(p_lngRtn)
End Select
On Error GoTo 0
Err.Raise Number:=p_lngRtn, _
Description:=p_strErr & vbCrLf & _
"Error in parameter " & p_lngParameterErr & _
" when attempting to add the user, " & xi_strUserName, _
Source:="Form1.AddUser"
Else
AddUser = True
End If
' ------------------------------------------
' Be a good programmer and free the memory
' you've allocated
' ------------------------------------------
p_lngRtn = NetApiBufferFree(p_lngPtrUserName)
p_lngRtn = NetApiBufferFree(p_lngPtrPassword)
p_lngRtn = NetApiBufferFree(p_lngPtrUserFullName)
p_lngRtn = NetApiBufferFree(p_lngPtrUserComment)
End Function
EDIT:
I have found the following example in msdn:
Option Explicit
On Error Resume Next
Dim scriptResult ' Script success or failure
Dim groupPath ' ADsPath to the group container
Dim group ' Group object
Dim memberPath ' ADsPath to the member
Dim member ' Member object
Dim groupMemberList ' Used to display group members
Dim errorText ' Error handing text
scriptResult = False
groupPath =
"LDAP://fabrikam.com/CN=TestGroup,OU=TestOU,DC=fabrikam,DC=com"
memberPath = "LDAP://CN=JeffSmith,OU=TestOU,DC=fabrikam,DC=com"
WScript.Echo("Retrieving group object")
Set group = GetObject(groupPath)
If Err.number <> vbEmpty then
Call ErrorHandler("Could not create group object.")
End If
Call ShowMembers(groupPath) 'Optional function call
WScript.Echo("Retrieving new member object")
Set member = GetObject(memberPath)
If Err.number <> vbEmpty then
Call ErrorHandler("Could not get new member object.")
End If
WScript.Echo("Adding member to group.")
group.Add(member.ADsPath)
If Err.number <> vbEmpty then
Call ErrorHandler("Could not add member to group.")
End If
Call ShowMembers(groupPath) ' Optional function call
scriptResult = True
Call FinalResult(scriptResult)
'****************************************************************
' This function displays the members of a group. The function
' takes the ADsPath of the group.
'****************************************************************
Sub ShowMembers(groupPath)
Dim groupMember
Dim groupMemberList
Dim groupObject
Set groupObject = GetObject(groupPath)
Set groupMemberList = groupObject.Members
Select Case groupMemberList.Count
Case 1
WScript.Echo vbcrlf & "The group has one member."
Case 0
WScript.Echo vbcrlf & "The group has no members."
Case Else
WScript.Echo vbcrlf & "The group has " &
groupMemberList.Count &
" members."
End Select
If groupMemberList.Count > 0 then
WScript.Echo vbcrlf & "Here is a member list."
For Each groupMember in groupMemberList
WScript.Echo groupMember.Name
Next
WScript.Echo vbcrlf
End If
Set groupObject = Nothing
Set groupMemberList = Nothing
End Sub
'****************************************************************
' This function shows if the script succeeded or failed. The
' function processed the scriptResult variable.
'****************************************************************
Sub FinalResult(scriptResult)
WScript.Echo vbcrlf
If scriptResult = False then
WScript.Echo "Script failed."
Else
WScript.Echo("Script successfully completed.")
End If
WScript.Quit
End Sub
'****************************************************************
' This function handles errors that occur in the script.
'****************************************************************
Sub ErrorHandler( errorText )
WScript.Echo(vbcrlf & errorText)
WScript.Echo("Error number: " & Err.number)
WScript.Echo("Error Description: " & Err.Description)
Err.Clear
Call FinalResult(scriptResult)
End Sub
Alternatively, you can use Windows Script Host to execute the net tool:
Set objShell = CreateObject("Wscript.Shell")
strCommand = "net localgroup Administrators /add DOMAIN\USERNAME"
Set objExec = objShell.Exec(strCommand)

CreateProcessWithLogon Error requires elevation

all
I am using CreateProcessWithLogon method to installing softwares for non autherized users to installing software, it was working fine for windows XP users, but same application shows the error as follows in windows 7 machine.
System.ComponentModel.Win32Exception(0x80004005): the requested operation requires elevation
please any one suggest me any idea to fix it.
i am using the code as follows
Private Const LOGON_NETCREDENTIALS_ONLY As Integer = &H2
Private Const NORMAL_PRIORITY_CLASS As Integer = &H20
Private Const CREATE_DEFAULT_ERROR_MODE As Integer = &H4000000
Private Const CREATE_NEW_CONSOLE As Integer = &H10
Private Const CREATE_NEW_PROCESS_GROUP As Integer = &H200
Private Const LOGON_WITH_PROFILE As Integer = &H1
Private Const LOGON_WITH_PROFILE1 As Integer = 0
Dim siStartup As STARTUPINFO
Dim piProcess As PROCESS_INFORMATION
Dim intReturn As Integer
Dim bResult As Boolean = False
Dim result As Integer
Dim sFile, sArg As String
IMP_USER_NAME = AppSettings("UserName")
IMP_PASS_WORD = AppSettings("Password")
IMP_DOMAIN_NAME = AppSettings("Domain")
Try
If sApplication.EndsWith(".msi") Then
sApplication = sApplication & " " & """ALLUSERS=1"""
sArg = "msiexec.exe /i """ & sApplication & """"
sFile = vbNullString
Else
If bToExecute = False Then
sArg = vbNullString
sFile = sApplication
Else
sArg = "cmd /c """ & sApplication & """"
sFile = vbNullString
End If
End If
siStartup.cb = Marshal.SizeOf(siStartup)
siStartup.dwFlags = 0
intReturn = CreateProcessWithLogon(IMP_USER_NAME, IMP_DOMAIN_NAME, IMP_PASS_WORD, LOGON_WITH_PROFILE, sFile, sArg, _
NORMAL_PRIORITY_CLASS Or CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP, _
IntPtr.Zero, IntPtr.Zero, siStartup, piProcess)
Thanks,
Senthil
See http://blogs.msdn.com/b/cjacks/archive/2010/02/01/why-can-t-i-elevate-my-application-to-run-as-administrator-while-using-createprocesswithlogonw.aspx : you need an intermediate process that execute ShellExec() to elevate the priveleges of an application called with CreateProcessWithLogon
Alternativeley, you can call cmd /c cd <targetDir>&<targetDrive>:&<execName> with CreateProcessWithLogon to avoid creating that intermediate process.
Probably the reason is that you use LOGON_WITH_PROFILE flag. In the "Remark" part of the CreateProcessWithLogonW documentation you can read following
By default, CreateProcessWithLogonW
does not load the specified user
profile into the HKEY_USERS registry
key. This means that access to
information in the HKEY_CURRENT_USER
registry key may not produce results
that are consistent with a normal
interactive logon. It is your
responsibility to load the user
registry hive into HKEY_USERS before
calling CreateProcessWithLogonW, by
using LOGON_WITH_PROFILE, or by
calling the LoadUserProfile function.
So I recommend you to try the same code without LOGON_WITH_PROFILE flag. If you will see that it was the problem and you do need to use the flag you should use LoadUserProfile function and UnloadUserProfile in your code.

Resources