shell "runas /profile user:(имя юзера) ..."
Option Explicit
Private Declare Function LogonUser Lib "advapi32.dll" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Private Const LOGON32_PROVIDER_DEFAULT As Long = 0&
Private Const LOGON32_PROVIDER_WINNT35 As Long = 1&
Private Const LOGON32_LOGON_INTERACTIVE As Long = 2&
Private Const LOGON32_LOGON_NETWORK As Long = 3&
Private Const LOGON32_LOGON_BATCH As Long = 4&
Private Const LOGON32_LOGON_SERVICE As Long = 5&
Public Function doLogon(ByVal strAdminUser As String, ByVal strAdminPassword As String, ByVal strAdminDomain As String) As Boolean
On Error GoTo DamnErr
Dim lngTokenHandle As Long
Dim lngLogonType As Long
Dim lngLogonProvider As Long
Dim blnResult As Boolean
lngLogonType = LOGON32_LOGON_INTERACTIVE
lngLogonProvider = LOGON32_PROVIDER_DEFAULT
blnResult = RevertToSelf()
blnResult = LogonUser(strAdminUser, strAdminDomain, strAdminPassword, _
lngLogonType, lngLogonProvider, _
lngTokenHandle)
lngLogonType = Err.LastDllError
blnResult = ImpersonateLoggedOnUser(lngTokenHandle)
doLogon = blnResult
Exit Function
DamnErr:
Dim sERRORtxt As String
sERRORtxt = "Error Number: " & Err.Number & vbCrLf & _
"Description: " & Err.Description & vbCrLf & _
"Source: " & Err.Source & vbCrLf & _
"Function: doLogon" & vbCrLf & _
"Date: " & Now() & vbCrLf & _
"Input:" & vbCrLf & _
" strAdminUser=" & strAdminUser & vbCrLf & _
" strAdminPassword=" & strAdminPassword & vbCrLf & _
" strAdminDomain=" & strAdminDomain
app.LogEvent sERRORtxt, vbLogEventTypeError
Err.Clear
End Function
Public Function doLogoff() As Boolean
On Error GoTo DamnErr
doLogoff = RevertToSelf()
Exit Function
DamnErr:
Dim sERRORtxt As String
sERRORtxt = "Error Number: " & Err.Number & vbCrLf & _
"Description: " & Err.Description & vbCrLf & _
"Source: " & Err.Source & vbCrLf & _
"Function: doLogoff" & vbCrLf & _
"Date: " & Now()
app.LogEvent sERRORtxt, vbLogEventTypeError
Err.Clear
End Function
doLogon "username", "password", "domain-if-needed"
' Код, выполняемый от имени другого пользователя
'MAKE SURE TO LOGOFF!
'doLogoff
Сейчас этот форум просматривают: Google-бот, SemrushBot и гости: 190