如何截获执行

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

Option Explicit

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, 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 Type SECURITY_ATTRIBUTES

nLength As Long

lpSecurityDescriptor As Long

bInheritHandle As Long

End Type

Private Type STARTUPINFO

cb As Long

lpReserved As String

lpDesktop As String

lpTitle As String

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 Declare Function CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As SECURITY_ATTRIBUTES, ByVal lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, ByVal lpStartupInfo As STARTUPINFO, ByVal lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20

Private Const STARTF_USESTDHANDLES = &H100

Private Const STARTF_USESHOWWINDOW = &H1

Private Function ExecuteCommandLineOutput(CommandLine As String, Optional BufferSize As Long = 256, Optional TimeOut As Long) As String

Dim Proc As PROCESS_INFORMATION

Dim Start As STARTUPINFO

Dim SA As SECURITY_ATTRIBUTES

Dim hReadPipe As Long

Dim hWritePipe As Long

Dim lBytesRead As Long

Dim sBuffer As String

If VBA.Len(CommandLine) > 0 Then

SA.nLength = Len(SA)

'SA.nLength = vba.Len(sa)

SA.bInheritHandle = 1&

SA.lpSecurityDescriptor = 0&

If CreatePipe(hReadPipe, hWritePipe, SA, 0) > 0 Then

Start.cb = Len(Start)

Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

Start.hStdOutput = hWritePipe

Start.hStdError = hWritePipe

If CreateProcessA(0&, CommandLine, SA, SA, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc) = 1 Then

CloseHandle hWritePipe

sBuffer = VBA.String(BufferSize, VBA.Chr(0))

If TimeOut > 0 Then

Dim BeginTime As Date

BeginTime = VBA.Now

End If

Do Until ReadFile(hReadPipe, sBuffer, BufferSize, lBytesRead, 0&) = 0

DoEvents

If TimeOut > 0 Then

If VBA.DateDiff("s", BeginTime, VBA.Now) > TimeOut Then

ExecuteCommandLineOutput = "Timeout"

Exit Do

End If

End If

ExecuteCommandLineOutput = ExecuteCommandLineOutput & VBA.Left(sBuffer, lBytesRead)

Loop

CloseHandle Proc.hProcess

CloseHandle Proc.hThread

CloseHandle hReadPipe

Else

ExecuteCommandLineOutput = "File or command not found"

End If

Else

ExecuteCommandLineOutput = "CreatePipe failed. Error: " & Err.LastDllError & "."

End If

End If

End Function

Private Sub Command1_Click() '测试

'VBA.MsgBox ExecuteCommandLineOutput("ping www.sina.com.cn")

VBA.MsgBox ExecuteCommandLineOutput("ping www.xxxx.com.cn", , 2)

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航