Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21243

Reopened: CreateProcessWithLogon Problems

$
0
0
The problem is when running this from startup/when Windows starts up it fails with Access Denied... I found that if I added code from Karl Peterson if works if I addd a msgbox.. weird.. First off I don't understand why by adding a msgbox allows it to work... if I remove the messagebox I still get "access denied" If I remove the messagebox and the code from Karl it doesn't work at all... Any suggestions?
Code:

Option Explicit

'*************************************************************************************************
'    Module    : m_CommandLine (new)
'*************************************************************************************************

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessW" (ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CreateProcessWithLogon Lib "advapi32" Alias "CreateProcessWithLogonW" (ByVal lpUsername As Long, ByVal lpDomain As Long, ByVal lpPassword As Long, ByVal dwLogonFlags As Long, ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInfo As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As Any, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Long) As Long


Private Const TOKEN_QUERY As Long = &H8
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Private Const SE_BACKUP_NAME As String = "SeBackupPrivilege"
Private Const SE_RESTORE_NAME As String = "SeRestorePrivilege"
Private Const SE_PRIVILEGE_ENABLED As Long = &H2

Private Type LARGE_INTEGER
  lowpart As Long
  highpart As Long
End Type

Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  LUID As LARGE_INTEGER
  Attributes As Long
End Type

       
Private Type SECURITY_ATTRIBUTES
    nLength                As Long
    lpSecurityDescriptor    As Long
    bInheritHandle          As Long
End Type
     
Private Type STARTUPINFO
    cb                      As Long
    lpReserved              As Long
    lpDesktop              As Long
    lpTitle                As Long
    dwX                    As Long
    dwY                    As Long
    dwXSize                As Long
    dwYSize                As Long
    dwXCountChars          As Long
    dwYCountChars          As Long
    dwFillAttribute        As Long
    dwFlags                As Long
    wShowWindow            As Integer
    cbReserved2            As Integer
    lpReserved2            As Long
    hStdInput              As Long
    hStdOutput              As Long
    hStdError              As Long
End Type
     
Private Type PROCESS_INFORMATION
    hProcess                As Long
    hThread                As Long
    dwProcessID            As Long
    dwThreadID              As Long
End Type
       
Private Const NORMAL_PRIORITY_CLASS        As Long = &H20&

Private Const STARTF_USESTDHANDLES          As Long = &H100&
Private Const STARTF_USESHOWWINDOW          As Long = &H1

Private Const LOGON_WITH_PROFILE            As Long = &H1&
Private Const LOGON_NETCREDENTIALS_ONLY    As Long = &H2&

Private Const CREATE_DEFAULT_ERROR_MODE    As Long = &H4000000
Private Const CREATE_NEW_CONSOLE            As Long = &H10&
Private Const CREATE_NEW_PROCESS_GROUP      As Long = &H200&
Private Const CREATE_SEPARATE_WOW_VDM      As Long = &H800&
Private Const CREATE_SUSPENDED              As Long = &H4&
Private Const CREATE_UNICODE_ENVIRONMENT    As Long = &H400&

Private Const ERROR_ACCESS_DENIED          As Long = 5&

Private m_Debugging                        As Boolean

Public Function ExecuteCommandLine(Optional ByVal UserName As String, Optional ByVal Password As String, Optional ByVal Domain As String, Optional ByVal strDirectory As String = vbNullString, Optional CommandLine As String) As String
    Dim typProcess          As PROCESS_INFORMATION
    Dim typStartup          As STARTUPINFO
    Dim typSecurity        As SECURITY_ATTRIBUTES
    Dim lngReadPipe        As Long
    Dim lngWritePipe        As Long
    Dim lngBytesRead        As Long
    Dim lngResult          As Long
    Dim lngSuccess          As Long
    Dim strBuffer          As String
    Dim strReturn          As String
    Dim lngTokenHandle      As Long

   
    typSecurity.nLength = Len(typSecurity)
    typSecurity.bInheritHandle = 1&
    typSecurity.lpSecurityDescriptor = 0&
   
    lngResult = CreatePipe(lngReadPipe, lngWritePipe, typSecurity, 0)
 
    If lngResult = 0 Then
        MsgBox "CreatePipe failed Error!"
        Exit Function
    End If
 
    typStartup.cb = Len(typStartup)
    typStartup.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    typStartup.hStdInput = lngWritePipe
    typStartup.hStdOutput = lngWritePipe
    typStartup.hStdError = lngWritePipe
   
    If Len(UserName) <> 0 Or Len(Password) <> 0 Then
        lngResult = CreateProcessWithLogon(StrPtr(UserName), StrPtr(Domain), StrPtr(Password), LOGON_WITH_PROFILE, StrPtr(vbNullString), StrPtr(CommandLine), CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP Or CREATE_UNICODE_ENVIRONMENT, ByVal 0&, StrPtr(strDirectory), typStartup, typProcess)
        If Err.LastDllError = ERROR_ACCESS_DENIED Then

              'IF I ADD A MSGBOX HERE IT WORKS
              msgbox "It failed.. Setting DebugPrivs"
                m_Debugging = DebugPrivs(True)
           
   
   

           

            lngResult = CreateProcessWithLogon(StrPtr(UserName), StrPtr(Domain), StrPtr(Password), LOGON_WITH_PROFILE, StrPtr(vbNullString), StrPtr(CommandLine), CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP Or CREATE_UNICODE_ENVIRONMENT, ByVal 0&, StrPtr(strDirectory), typStartup, typProcess)
        End If
    Else
        If Err.LastDllError = ERROR_ACCESS_DENIED Then
            'm_Debugging = DebugPrivs(True)
            lngResult = CreateProcess(StrPtr(vbNullString), StrPtr(CommandLine), typSecurity, typSecurity, ByVal 1&, NORMAL_PRIORITY_CLASS Or CREATE_UNICODE_ENVIRONMENT, ByVal 0&, StrPtr(strDirectory), typStartup, typProcess)
        End If
    End If

    If lngResult <> 0 Then
     
        Dim lngPeekData As Long
       
        Do
            Call PeekNamedPipe(lngReadPipe, ByVal 0&, 0&, ByVal 0&, lngPeekData, ByVal 0&)
           
            If lngPeekData > 0 Then
                strBuffer = Space$(lngPeekData)
                lngSuccess = ReadFile(lngReadPipe, strBuffer, Len(strBuffer), lngBytesRead, 0&)
               
                If lngSuccess = 1 Then
                    strReturn = strReturn & Left$(strBuffer, lngBytesRead)
                Else
                    MsgBox "ReadFile failed!"
                End If
            Else
                lngSuccess = WaitForSingleObject(typProcess.hProcess, 0&)
                       
                If lngSuccess = 0 Then
                    Exit Do
                End If
            End If
           
            DoEvents
        Loop
    Else
        MsgBox GetSystemErrorMessageText(Err.LastDllError)
    End If
   
    If m_Debugging Then Call DebugPrivs(False)
   
    Call RevertToSelf
   
    Call CloseHandle(typProcess.hProcess)
    Call CloseHandle(typProcess.hThread)
    Call CloseHandle(lngReadPipe)
    Call CloseHandle(lngWritePipe)
   
    ExecuteCommandLine = strReturn
End Function

Private Function DebugPrivs(ByVal Enable As Boolean) As Boolean
    Dim hProcess            As Long
    Dim DesiredAccess      As Long
    Dim hToken              As Long
    Dim nRet                As Long
    Dim tkp                As TOKEN_PRIVILEGES
   
    Static bup              As TOKEN_PRIVILEGES 'cache privilges
 
    'Get psuedohandle to current process.
    hProcess = GetCurrentProcess()
    'Ask for handle to query and adjust process tokens.
   
    DesiredAccess = TOKEN_QUERY Or TOKEN_ADJUST_PRIVILEGES
    If OpenProcessToken(hProcess, DesiredAccess, hToken) Then
      ' Get LUID for backup privilege name.
      If LookupPrivilegeValue(vbNullString, SE_DEBUG_NAME, tkp.LUID) Then
        If Enable Then
            ' Enable the debug priviledge.
            tkp.PrivilegeCount = 1
            tkp.Attributes = SE_PRIVILEGE_ENABLED
            If AdjustTokenPrivileges(hToken, False, tkp, Len(bup), bup, nRet) Then
              DebugPrivs = True
            End If
        Else
            ' Restore prior debug privilege setting.
            If AdjustTokenPrivileges(hToken, False, bup, 0&, ByVal 0&, nRet) Then
              DebugPrivs = True
            End If
        End If
      End If
      ' Clean up token handle.
      Call CloseHandle(hToken)
  End If
End Function


Viewing all articles
Browse latest Browse all 21243

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>