About Script

Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION

Dim wUser As String
Dim wDomain As String
Dim wPassword As String
Dim wCommandLine As String
Dim wCurrentDir As String

Dim Result As Long

si.cb = Len(si)

wUser = StrConv(UserName + Chr$(0), vbUnicode)
wDomain = StrConv(DomainName + Chr$(0), vbUnicode)
wPassword = StrConv(Password + Chr$(0), vbUnicode)
wCommandLine = StrConv(CommandLine + Chr$(0), vbUnicode)
wCurrentDir = StrConv(CurrentDirectory + Chr$(0), vbUnicode)

Result = CreateProcessWithLogonW(wUser, wDomain, wPassword, _
LOGON_WITH_PROFILE, 0&, wCommandLine, _
CREATE_DEFAULT_ERROR_MODE, 0&, wCurrentDir, si, pi)
' CreateProcessWithLogonW() does not
If Result <> 0 Then
CloseHandle pi.hThread
CloseHandle pi.hProcess
W2KRunAsUser = 0
Else
W2KRunAsUser = Err.LastDllError
MsgBox "CreateProcessWithLogonW() failed with error " & Err.LastDllError, vbExclamation
End If

End Function

'********************************************************************
' RunAsUser for Windows NT 4.0
'********************************************************************

Public Function NT4RunAsUser(ByVal UserName As String, _
ByVal Password As String, _
ByVal DomainName As String, _
ByVal CommandLine As String, _
ByVal CurrentDirectory As String) As Long
Dim Result As Long
Dim hToken As Long
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION

Result = LogonUser(UserName, DomainName, Password, _
LOGON32_LOGON_INTERACTIVE, _
LOGON32_PROVIDER_DEFAULT, hToken)
If Result = 0 Then

NT4RunAsUser = Err.LastDllError
MsgBox "LogonUser() failed with error " & _
Err.LastDllError, vbExclamation

Exit Function
End If

si.cb = Len(si)
Result = CreateProcessAsUser(hToken, 0&, CommandLine, _
0&, 0&, False, _
CREATE_DEFAULT_ERROR_MODE, _
0&, CurrentDirectory, si, pi)
If Result = 0 Then
NT4RunAsUser = Err.LastDllError
MsgBox "CreateProcessAsUser() failed with error " & _
Err.LastDllError, vbExclamation
CloseHandle hToken
Exit Function
End If

CloseHandle hToken
CloseHandle pi.hThread
CloseHandle pi.hProcess
NT4RunAsUser = 0

End Function

Public Function RunAsUser(ByVal UserName As String, _
ByVal Password As String, _
ByVal DomainName As String, _
ByVal CommandLine As String, _
ByVal CurrentDirectory As String) As Long

Dim w2kOrAbove As Boolean
Dim osinfo As OSVERSIONINFO
Dim Result As Long
Dim uErrorMode As Long

' Determine if system is Windows 2000 or later
osinfo.dwOSVersionInfoSize = Len(osinfo)
osinfo.szCSDVersion = Space$(128)
GetVersionExA osinfo
w2kOrAbove = _
(osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
osinfo.dwMajorVersion >= 5)
If (w2kOrAbove) Then
Result = W2KRunAsUser(UserName, Password, DomainName, _
CommandLine, CurrentDirectory)
Else
Result = NT4RunAsUser(UserName, Password, DomainName, _
CommandLine, CurrentDirectory)
End If
RunAsUser = Result
End Function


Private Sub Command1_Click()
'Contoh Penggunaan
RunAsUser "vbbego", "admin", "", "Notepad.exe", ""
End Sub