Locked EnumTCPConnections [Avanzado][Fakedo0r]

[Expermicid]

This is the hidden content, please

• Sign In
• or
• Sign Up

 

[lenguaje=delphi]//******************************************************************************

//* UNIT: UNT_EnumTCPConnections

//* AUTOR: Fakedo0r .:PD-TEAM:.

//* FECHA: 10.08.2012

//* CORREO: [email protected]

//* BLOG: Sub-Soul.blogspot.com / Sub-Soul.com

//******************************************************************************

Unit UNT_EnumTCPConnections;

//******************************************************************************

//DECLARACIONES DE LIBRERIAS / CLASES

//******************************************************************************

Interface

 

Uses

Winapi.Windows, Winapi.IpHlpApi, Winapi.IpRtrMib, Winapi.Messages,

System.SysUtils, System.Variants, PsAPI, TLHelp32,

System.Classes, Registry, ActiveX, WinSvc, Vcl.ComCtrls, Winsock,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

//******************************************************************************

//DECLARACIONES DE CONSTANTES

//******************************************************************************

Const

TCP_TABLE_OWNER_PID_ALL = 5;

//******************************************************************************

//DECLARACIONES DE ESTRUCTURAS

//******************************************************************************

Type

PMIB_TCPROW_OWNER_PID = ^MIB_TCPROW_OWNER_PID;

 

MIB_TCPROW_OWNER_PID = Packed Record

dwState: DWORD;

dwLocalAddr: DWORD;

dwLocalPort: DWORD;

dwRemoteAddr: DWORD;

dwRemotePort: DWORD;

dwOwningPid: DWORD;

End;

 

PMIB_TCPTABLE_OWNER_PID = ^MIB_TCPTABLE_OWNER_PID;

 

MIB_TCPTABLE_OWNER_PID = Packed Record

dwNumEntries: DWORD;

table: Array [0 .. 0] Of MIB_TCPROW_OWNER_PID;

End;

 

TCP_TABLE_CLASS = Integer;

//******************************************************************************

//DECLARACIONES DE LIBRERIAS / CLASES EXTERNAS

//******************************************************************************

Function GetExtendedTcpTable(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;

lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWORD; Stdcall;

External 'iphlpapi.dll';

//******************************************************************************

//DECLARACIONES DE FUNCIONES / PROCEDIMIENTOS

//******************************************************************************

Function EnumTCPConnections: TStringList;

Function IPToStr(iValue: Integer): String;

Function StateToStr(dwState: DWORD): String;

Function GetProcName(iPID: Integer): String;

Function CloseConnection(dwID: DWORD): BOOL;

Function KillProcess(dwPID: DWORD): BOOL;

//******************************************************************************

Implementation

//******************************************************************************

//<--- ENUMERA LAS CONEXIONES --->

//******************************************************************************

Function EnumTCPConnections: TStringList;

Var

dwSize: DWORD;

dwIndex: DWORD;

tArrTemp: TStringList;

tTCPTOP: PMIB_TCPTABLE_OWNER_PID;

Begin

tArrTemp := TStringList.Create;

dwSize := 0;

 

If GetExtendedTcpTable(Nil, @dwSize , False, AF_INET,

TCP_TABLE_OWNER_PID_ALL, 0) <> ERROR_INSUFFICIENT_BUFFER Then

Exit;

 

GetMem(tTCPTOP, dwSize);

 

If GetExtendedTcpTable(tTCPTOP, @dwSize , True, AF_INET,

TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR Then

For dwIndex := 0 To tTCPTOP.dwNumEntries - 1 Do

tArrTemp.Add(GetProcName(tTCPTOP.table[dwIndex].dwOwningPid) + #13#10 +

IntToStr(tTCPTOP.table[dwIndex].dwOwningPid) + #13#10 +

IpToStr(tTCPTOP.table[dwIndex].dwLocalAddr) + #13#10 +

IntToStr(htons(tTCPTOP.table[dwIndex].dwLocalPort)) + #13#10 +

IpToStr(tTCPTOP.table[dwIndex].dwRemoteAddr) + #13#10 +

IntToStr(htons(tTCPTOP.table[dwIndex].dwRemotePort)) + #13#10 +

StateToStr(tTCPTOP.table[dwIndex].dwState));

FreeMem(tTCPTOP);

Result := tArrTemp;

End;

//******************************************************************************

//<--- CIERRA X CONEXION --->

//******************************************************************************

Function CloseConnection(dwID: DWORD): BOOL;

Var

dwSize: DWORD;

dwIndex: DWORD;

tTCPTABLE: PMIB_TCPTABLE;

Begin

dwSize := 0;

GetMem(tTCPTABLE, SizeOf(MIB_TCPTABLE));

 

If GetTcpTable(tTCPTABLE, dwSize, True) <> ERROR_INSUFFICIENT_BUFFER Then

Exit;

GetMem(tTCPTABLE, dwSize);

 

If GetTcpTable(tTCPTABLE, dwSize, True) = NO_ERROR Then

If tTCPTABLE.table[dwID].dwState <> MIB_TCP_STATE_LISTEN Then

Begin

tTCPTABLE.table[dwID].dwState := MIB_TCP_STATE_DELETE_TCB;

 

If SetTcpEntry(tTCPTABLE.table[dwID]) = NO_ERROR Then

Result := True

Else

Result := False;

End;

FreeMem(tTCPTABLE);

End;

//******************************************************************************

//<--- CIERRA X PROCESOS APARTIR DE PID --->

//******************************************************************************

Function KillProcess(dwPID: DWORD): BOOL;

var

tProc: THandle;

begin

Try

tProc := OpenProcess(PROCESS_ALL_ACCESS, True, dwPID);

 

If TerminateProcess(tProc, 0) Then

Result := True

Except

Result := False;

End;

end;

//******************************************************************************

//<--- MUESTRA EL ESTADO DE X CONEXION --->

//******************************************************************************

Function StateToStr(dwState: DWORD): String;

Var

sTemp: String;

Begin

Case dwState Of

MIB_TCP_STATE_CLOSED: sTemp := 'CLOSED';

MIB_TCP_STATE_LISTEN: sTemp := 'LISTENING';

MIB_TCP_STATE_SYN_SENT: sTemp := 'SYN_SENT';

MIB_TCP_STATE_SYN_RCVD: sTemp := 'SYN_RCVD';

MIB_TCP_STATE_ESTAB: sTemp := 'ESTABLISHED';

MIB_TCP_STATE_FIN_WAIT1: sTemp := 'FIN_WAIT1';

MIB_TCP_STATE_FIN_WAIT2: sTemp := 'FIN_WAIT2';

MIB_TCP_STATE_CLOSE_WAIT: sTemp := 'CLOSE_WAIT';

MIB_TCP_STATE_CLOSING: sTemp := 'CLOSING';

MIB_TCP_STATE_LAST_ACK: sTemp := 'LAST_ACK';

MIB_TCP_STATE_TIME_WAIT: sTemp := 'TIME_WAIT';

MIB_TCP_STATE_DELETE_TCB: sTemp := 'DELETE_TCB';

End;

 

Result := sTemp;

End;

//******************************************************************************

//<--- CONVIERTE IP A CADENA --->

//******************************************************************************

Function IPToStr(iValue: Integer): String;

Var

y1: Byte;

y2: Byte;

x1: WORD;

x2: WORD;

Begin

Result := '';

 

x1 := iValue Shr 16;

x2 := iValue And $FFFF;

y1 := x1 Div $100;

y2 := x1 Mod $100;

 

Result := IntToStr(y1) + '.' + IntToStr(y2) + '.';

 

y1 := x2 Div $100;

y2 := x2 Mod $100;

 

Result := Result + IntToStr(y1) + '.' + IntToStr(y2);

End;

//******************************************************************************

//<--- OBTIENE EL NOMBRE DE PROCESO APARTIR DE PID --->

//******************************************************************************

Function GetProcName(iPID: Integer): String;

Var

tSnapShot: THandle;

tProcEntry: TProcessEntry32;

Begin

tSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

tProcEntry.dwSize := Sizeof(tProcEntry);

 

If Process32First(tSnapShot, tProcEntry) Then

Begin

Repeat

If tProcEntry.th32ProcessID = iPID Then

Begin

Result := tProcEntry.szExeFile;

Break;

End;

Until Not Process32Next(tSnapShot, tProcEntry);

End;

 

CloseHandle(tSnapShot);

End;

 

End.[/lenguaje]

Edited February 16, 2014 by Expermicid