)Option Explicit
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 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 Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) 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 Const SW_HIDE = 0
Private Sub cmdExecute_Click()
Dim strPing As String
Dim Reply As Long
' Ping IP Address
strPing = ExecuteApp("cmd /c ping " & txtIP)
' If a reply was found set the position it was found
Reply = 0
Reply = InStr(4, strPing, "reply", 1)
' If the position of the reply is not equal to 0
If Reply <> 0 Then
Dim objNetSend
objNetSend = Shell("C:\WINNT\SYSTEM32\CMD.EXE /c net send " & txtIP & " My Message Will Be Sent", 0)
End If
End Sub
Private Function ExecuteApp(sCmdline As String) As String
Dim proc As PROCESS_INFORMATION, ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long 'The handle used to read from the pipe.
Dim hWritePipe As Long 'The pipe where StdOutput and StdErr will be redirected to.
Dim sOutput As String
Dim lngBytesRead As Long, sBuffer As String * 256
sa.nLength = Len(sa)
sa.bInheritHandle = True
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
Exit Function
End If
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
' Redirect the standard output and standard error to the same pipe
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
start.wShowWindow = SW_HIDE
' Start the shelled application:
' if you program has to work only on NT you don't need the "conspawn "
ret = CreateProcessA(0&, sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret = 0 Then
MsgBox "CreateProcess failed. Error: " & Err.LastDllError
Exit Function
End If
' The handle wWritePipe has been inherited by the shelled application
' so we can close it now
CloseHandle hWritePipe
' Read the characters that the shelled application
' has outputed 256 characters at a time
Do
ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
sOutput = sOutput & Left$(sBuffer, lngBytesRead)
Loop While ret <> 0 ' if ret = 0 then there is no more characters to read
CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe
ExecuteApp = sOutput ' Return the output of shelled program.
End Function