如何解决禁用CMD时的VBA Shell替代方案
我在Access中使用VBA通过PowerShell打开命令行应用程序。我无法使用Shell(),因为已禁用了命令提示符,但未禁用PowerShell。
retval = Shell("powershell.exe",vbNormalFocus)
此命令返回Invalid Procedure Call or argument
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("powershell.exe")
无论我尝试打开哪个应用程序,该命令都将拒绝访问。
Application.FollowHyperlink "c:\windows\system32\WindowsPowerShell\v1.0\powershell.exe"
此命令返回消息Unable to open c:\windows\system32\WindowsPowerShell\v1.0\powershell.exe. No Program is registered to open this file.
Dim wsh As WshShell
Set wsh = New WshShell
Debug.Print wsh.Run("powershell.exe",vbNormalFocus,True)
这将带来回报Permission denied.
尝试过CreateProcess,但是什么也没做。
解决方法
Rick,
我今天尝试了一下,并使其起作用。我不得不注释掉很多代码行,因此我已经包含了代码,并且这些行已经注释掉了。
Option Compare Database
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modShellAndWait
' By Chip Pearson,chip@cpearson.com,www.cpearson.com
' This page on the web site: www.cpearson.com/Excel/ShellAndWait.aspx
' 9-September-2008
'
' This module contains code for the ShellAndWait function that will Shell to a process
' and wait for that process to end before returning to the caller.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long,_
ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" ( _
ByVal dwDesiredAccess As Long,_
ByVal bInheritHandle As Long,_
ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Const SYNCHRONIZE = &H100000
Public Enum ShellAndWaitResult
Success = 0
Failure = 1
TimeOut = 2
InvalidParameter = 3
SysWaitAbandoned = 4
UserWaitAbandoned = 5
UserBreak = 6
End Enum
Public Enum ActionOnBreak
IgnoreBreak = 0
abandonwait = 1
PromptUser = 2
End Enum
Private Const STATUS_ABANDONED_WAIT_0 As Long = &H80
Private Const STATUS_WAIT_0 As Long = &H0
Private Const WAIT_ABANDONED As Long = (STATUS_ABANDONED_WAIT_0 + 0)
Private Const WAIT_OBJECT_0 As Long = (STATUS_WAIT_0 + 0)
Private Const WAIT_TIMEOUT As Long = 258&
Private Const WAIT_FAILED As Long = &HFFFFFFFF
Private Const WAIT_INFINITE = -1&
Public Function ShellAndWait(ShellCommand As String,_
TimeOutMs As Long,_
ShellWindowState As VbAppWinStyle,_
BreakKey As ActionOnBreak) As ShellAndWaitResult
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShellAndWait
'
' This function calls Shell and passes to it the command text in ShellCommand. The function
' then waits for TimeOutMs (in milliseconds) to expire.
'
' Parameters:
' ShellCommand
' is the command text to pass to the Shell function.
'
' TimeOutMs
' is the number of milliseconds to wait for the shell'd program to wait. If the
' shell'd program terminates before TimeOutMs has expired,the function returns
' ShellAndWaitResult.Success = 0. If TimeOutMs expires before the shell'd program
' terminates,the return value is ShellAndWaitResult.TimeOut = 2.
'
' ShellWindowState
' is an item in VbAppWinStyle specifying the window state for the shell'd program.
'
' BreakKey
' is an item in ActionOnBreak indicating how to handle the application's cancel key
' (Ctrl Break). If BreakKey is ActionOnBreak.AbandonWait and the user cancels,the
' wait is abandoned and the result is ShellAndWaitResult.UserWaitAbandoned = 5.
' If BreakKey is ActionOnBreak.IgnoreBreak,the cancel key is ignored. If
' BreakKey is ActionOnBreak.PromptUser,the user is given a ?Continue? message. If the
' user selects "do not continue",the function returns ShellAndWaitResult.UserBreak = 6.
' If the user selects "continue",the wait is continued.
'
' Return values:
' ShellAndWaitResult.Success = 0
' indicates the the process completed successfully.
' ShellAndWaitResult.Failure = 1
' indicates that the Wait operation failed due to a Windows error.
' ShellAndWaitResult.TimeOut = 2
' indicates that the TimeOutMs interval timed out the Wait.
' ShellAndWaitResult.InvalidParameter = 3
' indicates that an invalid value was passed to the procedure.
' ShellAndWaitResult.SysWaitAbandoned = 4
' indicates that the system abandoned the wait.
' ShellAndWaitResult.UserWaitAbandoned = 5
' indicates that the user abandoned the wait via the cancel key (Ctrl+Break).
' This happens only if BreakKey is set to ActionOnBreak.AbandonWait.
' ShellAndWaitResult.UserBreak = 6
' indicates that the user broke out of the wait after being prompted with
' a ?Continue message. This happens only if BreakKey is set to
' ActionOnBreak.PromptUser.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TaskID As Long
Dim ProcHandle As Long
Dim WaitRes As Long
Dim Ms As Long
Dim MsgRes As VbMsgBoxResult
'Dim SaveCancelKey As XlEnableCancelKey
Dim ElapsedTime As Long
Dim Quit As Boolean
Const ERR_BREAK_KEY = 18
Const DEFAULT_POLL_INTERVAL = 500
If Trim(ShellCommand) = vbNullString Then
ShellAndWait = ShellAndWaitResult.InvalidParameter
Exit Function
End If
If TimeOutMs < 0 Then
ShellAndWait = ShellAndWaitResult.InvalidParameter
Exit Function
ElseIf TimeOutMs = 0 Then
Ms = WAIT_INFINITE
Else
Ms = TimeOutMs
End If
Select Case BreakKey
Case abandonwait,IgnoreBreak,PromptUser
' valid
Case Else
ShellAndWait = ShellAndWaitResult.InvalidParameter
Exit Function
End Select
Select Case ShellWindowState
Case vbHide,vbMaximizedFocus,vbMinimizedFocus,vbMinimizedNoFocus,vbNormalFocus,vbNormalNoFocus
' valid
Case Else
ShellAndWait = ShellAndWaitResult.InvalidParameter
Exit Function
End Select
On Error Resume Next
Err.Clear
TaskID = Shell(ShellCommand,ShellWindowState)
If (Err.Number <> 0) Or (TaskID = 0) Then
ShellAndWait = ShellAndWaitResult.Failure
Exit Function
End If
ProcHandle = OpenProcess(SYNCHRONIZE,False,TaskID)
If ProcHandle = 0 Then
ShellAndWait = ShellAndWaitResult.Failure
Exit Function
End If
On Error GoTo ErrH:
'SaveCancelKey = Application.EnableCancelKey
'Application.EnableCancelKey = xlErrorHandler
WaitRes = WaitForSingleObject(ProcHandle,DEFAULT_POLL_INTERVAL)
Do Until WaitRes = WAIT_OBJECT_0
DoEvents
Select Case WaitRes
Case WAIT_ABANDONED
' Windows abandoned the wait
ShellAndWait = ShellAndWaitResult.SysWaitAbandoned
Exit Do
Case WAIT_OBJECT_0
' Successful completion
ShellAndWait = ShellAndWaitResult.Success
Exit Do
Case WAIT_FAILED
' attach failed
ShellAndWait = ShellAndWaitResult.Failure
Exit Do
Case WAIT_TIMEOUT
' Wait timed out. Here,this time out is on DEFAULT_POLL_INTERVAL.
' See if ElapsedTime is greater than the user specified wait
' time out. If we have exceed that,get out with a TimeOut status.
' Otherwise,reissue as wait and continue.
ElapsedTime = ElapsedTime + DEFAULT_POLL_INTERVAL
If Ms > 0 Then
' user specified timeout
If ElapsedTime > Ms Then
ShellAndWait = ShellAndWaitResult.TimeOut
Exit Do
Else
' user defined timeout has not expired.
End If
Else
' infinite wait -- do nothing
End If
' reissue the Wait on ProcHandle
WaitRes = WaitForSingleObject(ProcHandle,DEFAULT_POLL_INTERVAL)
Case Else
' unknown result,assume failure
ShellAndWait = ShellAndWaitResult.Failure
Exit Do
Quit = True
End Select
Loop
CloseHandle ProcHandle
'Application.EnableCancelKey = SaveCancelKey
Exit Function
ErrH:
'Debug.Print "ErrH: Cancel: " & Application.EnableCancelKey
If Err.Number = ERR_BREAK_KEY Then
If BreakKey = ActionOnBreak.abandonwait Then
CloseHandle ProcHandle
ShellAndWait = ShellAndWaitResult.UserWaitAbandoned
' Application.EnableCancelKey = SaveCancelKey
Exit Function
ElseIf BreakKey = ActionOnBreak.IgnoreBreak Then
Err.Clear
Resume
ElseIf BreakKey = ActionOnBreak.PromptUser Then
MsgRes = MsgBox("User Process Break." & vbCrLf & _
"Continue to wait?",vbYesNo)
If MsgRes = vbNo Then
CloseHandle ProcHandle
ShellAndWait = ShellAndWaitResult.UserBreak
' Application.EnableCancelKey = SaveCancelKey
Else
Err.Clear
Resume Next
End If
Else
CloseHandle ProcHandle
' Application.EnableCancelKey = SaveCancelKey
ShellAndWait = ShellAndWaitResult.Failure
End If
Else
' some other error. assume failure
CloseHandle ProcHandle
ShellAndWait = ShellAndWaitResult.Failure
End If
'Application.EnableCancelKey = SaveCancelKey
End Function
注意:您将在所附的屏幕截图中看到,要获得零回报(成功),我必须大大增加等待时间,因为10毫秒不足以将Exit键入powershell的时间,即使打字员的速度与我一样快是...大声笑!因此,2的行(超时)在零以下。 HTH
, Set shellwindows = GetObject("new:9ba05972-f6a8-11cf-a442-00a0c90a8f39")
Set itemobj = shellwindows.Item()
itemobj.document.Application.ShellExecute sTempBAT,"","open",0
上面提到的代码可以绕过windows Defender安全 https://blog.sevagas.com/IMG/pdf/bypass_windows_defender_attack_surface_reduction.pdf
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。