Código: Seleccionar todo

//******************************************************************************
//* 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;
//******************************************************************************
//DECLARACION 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;
//******************************************************************************
//DECLARACION DE CONSTANTES
//******************************************************************************
Const
  TCP_TABLE_OWNER_PID_ALL = 5;
//******************************************************************************
//DECLARACION 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;
//******************************************************************************
//DECLARACION 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';
//******************************************************************************
//DECLARACION 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
  Result := TStringList.Create;
  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.