Autor
Pues andaba un poco aburrido ayer y me desidi a crear una shell local, con unas modificaiones podran meterla en un subproseso, una socket, o lo que se les ocurra
Les dejo el codigo y un ejemplo de uso
Código
' ****************************************************************************************************************************** '
'
' --- Autor: Jhonjhon_123 (Jhon Jairo Pro Developer)
' --- Versión: 1.0
' --- Descripción: Shell a nivel local en windows
' --- Fallos y Mejoras: MSN; j.j.g.p@hotmail.com
' --- Licencia: GNU General Public License
'
' ****************************************************************************************************************************** '
Option Explicit
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 ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function DuplicateHandle Lib "kernel32" (ByVal hSourceProcessHandle As Long, ByVal hSourceHandle As Long, ByVal hTargetProcessHandle As Long, lpTargetHandle As Long, ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwOptions As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Const STARTF_USESTDHANDLES As Long = &H100
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const DUPLICATE_SAME_ACCESS As Long = &H2
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
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
Dim lHInput As Long
Dim lHOutput As Long
Dim lCmdID As Long
Public Sub StopShell()
If lHInput > 0 Then Call CloseHandle(lHInput)
If lHOutput > 0 Then Call CloseHandle(lHOutput)
If lCmdID > 0 Then Call TerminateProcess(lCmdID, ByVal 0&): Call CloseHandle(lCmdID)
End Sub
Public Function GetOutTextShell(sOut As String) As Boolean
Dim bBuffer() As Byte
Dim lLen As Long
Dim bRes As Boolean
Dim lLenBuff As Long
bRes = CBool(PeekNamedPipe(lHOutput, 0&, 0&, 0&, lLen, 0&))
If Not bRes Then Exit Function
If lLen <= 0 Then Exit Function
ReDim bBuffer(lLen)
If ReadFile(lHOutput, bBuffer(0), lLen, lLenBuff, ByVal 0&) = 0 Then Exit Function
sOut = Left(StrConv(bBuffer, vbUnicode), lLenBuff)
GetOutTextShell = True
End Function
Public Sub SendToShell(sCMD As String)
Dim sBytes() As Byte
Dim BytesWritten As Long
If lHInput = 0 Then Exit Sub
sCMD = sCMD & vbNewLine
sBytes = StrConv(sCMD, vbFromUnicode)
If WriteFile(lHInput, ByVal sCMD, Len(sCMD), BytesWritten, 0&) = 0 Then
Exit Sub
End If
End Sub
Public Function StartShell() As Boolean
On Error GoTo Error
Dim tSecurityAttributes As SECURITY_ATTRIBUTES
Dim tStartInfo As STARTUPINFO
Dim tProcessInfo As PROCESS_INFORMATION
Dim lCurrentID As Long
lCurrentID = GetCurrentProcess()
With tStartInfo
.cb = Len(tStartInfo)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
End With
With tSecurityAttributes
.nLength = Len(tSecurityAttributes)
.bInheritHandle = 1
End With
If CreatePipe(lHOutput, tStartInfo.hStdOutput, tSecurityAttributes, 0) = 0 Then
GoTo Error
End If
If CreatePipe(tStartInfo.hStdInput, lHInput, tSecurityAttributes, 0) = 0 Then
GoTo Error
End If
If DuplicateHandle(lCurrentID, tStartInfo.hStdOutput, lCurrentID, tStartInfo.hStdError, 0&, True, DUPLICATE_SAME_ACCESS) = 0 Then
GoTo Error
End If
If CreateProcess(vbNullString, "cmd", tSecurityAttributes, tSecurityAttributes, 1, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, tStartInfo, tProcessInfo) = 0 Then
GoTo Error
End If
With tProcessInfo
Call CloseHandle(.hThread)
lCmdID = .hProcess
If .dwProcessID > 0 And .hProcess > 0 Then
StartShell = True
Else
GoTo Error
End If
End With
Exit Function
Error:
Call StopShell
StartShell = False
End Function
Descarga Ejemplo: http://www.multiupload.com/1NVDU8LZSP
Saludos
En línea
