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