unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
ListView1: TListView;
function getIP(
var addr) :
string;
procedure holeTcpTable;
function getPort(
var addr) :
string;
function getTCPState(status : integer) :
string;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
cCode: Word;
L :
record // L ist ein Record für das Auslesen der Werte
cbRequired : Longint;
// wird gebraucht, um die benötigte Buffer-Größe zu ermitteln
nStructSize : LongInt;
// Größe der Struktur
tmp :
String;
end;
type TMIB_TCPROW =
record
dwState : LongInt;
//state of the connection
dwLocalAddr :
array[0..3]
of byte ;
//address on local computer
dwLocalPort :
array[0..3]
of byte ;
//port number on local computer
dwRemoteAddr :
array[0..3]
of byte ;
//address on remote computer
dwRemotePort :
array[0..3]
of byte ;
//port number on remote computer
end;
type TMIB_TCPTABLE =
record
dwNumEntries : Longint;
//number of entries in the table
table :
array [0..100]
of TMIB_TCPROW;
//array of TCP connections
end;
function GetTcpTable (pTcpTable: Pointer;
var pdwSize : Longint; bOrder : Longint): Longint;
stdcall;
stdcall;
external '
iphlpapi'
name '
GetTcpTable';
Const MIB_TCP_STATE_CLOSED = 0;
Const MIB_TCP_STATE_LISTEN = 1;
Const MIB_TCP_STATE_SYN_SENT = 2;
Const MIB_TCP_STATE_SYN_RCVD = 3;
Const MIB_TCP_STATE_ESTAB = 4;
Const MIB_TCP_STATE_FIN_WAIT1 = 5;
Const MIB_TCP_STATE_FIN_WAIT2 = 6;
Const MIB_TCP_STATE_CLOSE_WAIT = 7;
Const MIB_TCP_STATE_CLOSING = 8;
Const MIB_TCP_STATE_LAST_ACK = 9;
Const MIB_TCP_STATE_TIME_WAIT = 10;
Const MIB_TCP_STATE_DELETE_TCB = 11;
{$R *.dfm}
procedure TForm1.holeTcpTable;
var liItem : Tlistitem;
var liste : TListitems;
var subitem : TStringlist;
var m_pTcpTable : ^TMIB_TCPTABLE;
var i : integer;
begin
Liste := Tlistitems.Create(listview1);
listview1.Items.Clear;
m_pTcpTable :=
nil;
ZeroMemory(@L,sizeof(L));
cCode := GetTcpTable(m_pTcpTable,L.cbRequired,0);
GetMem(m_pTcpTable,L.cbRequired);
ZeroMemory (m_pTcpTable,L.cbRequired);
cCode := GetTcpTable(m_pTcpTable,L.cbRequired,0);
// cCode als global vereinbarte Variable vom Type Word, um den Rückgabewert der API-Funktion zu erhalten
if cCode <> ERROR_SUCCESS
then
begin
showmessage ('
Fehler bei GetTcpTable ' + inttostr(cCode));
end
else
begin
for i:= 0
to m_pTcpTable.dwNumEntries-1
do
begin
showmessage('
A');
liItem := liste.Add;
subitem := TStringlist.Create;
subitem.Add(getIp(m_pTcpTable^.table[i].dwLocalAddr));
liItem.SubItems:=subitem;
liItem.Caption := '
TCP';
liItem.SubItems.Add (getPort(m_pTcpTable^.table[i].dwLocalPort));
liItem.SubItems.Add (getIp(m_pTcpTable^.table[i].dwRemoteAddr));
if (m_pTcpTable^.table[i].dwState-1 <> MIB_TCP_STATE_LISTEN)
then
begin
showmessage('
B');
liItem.SubItems.Add (getPort(m_pTcpTable^.table[i].dwRemotePort));
end
else
begin
showmessage('
C');
liItem.SubItems.Add ('
0');
end;
showmessage('
D');
liItem.SubItems.Add (getTCPState(m_pTcpTable^.table[i].dwState));
end;
end;
end;
// ein paar Funktionen zur Formatierung...
function TForm1.getIP(
var addr) :
string;
var daten :
array[0..3]
of byte
absolute addr;
begin
result := Format('
%d.%d.%d.%d',[Daten[0],daten[1],Daten[2],Daten[3]])
end;
function TForm1.getPort(
var addr) :
string;
var daten :
array[0..3]
of byte
absolute addr;
begin
result := Format('
%d',[Daten[0]*256+daten[1]]);
end;
function TForm1.getTCPState(status : integer) :
string;
begin
status := status -1 ;
if status = 0
then result := '
closed';
if status = 1
then result := '
listen';
if status = 2
then result := '
SYN_Sent';
if status = 3
then result := '
SYN_Rcvd';
if status = 4
then result := '
established';
if status = 5
then result := '
Fin wait 1';
if status = 6
then result := '
Fin wait 2';
if status = 7
then result := '
Close wait';
if status = 8
then result := '
closing';
if status = 9
then result := '
last Ack.';
if status = 10
then result := '
time wait';
if status = 11
then result := '
delete TCB';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
holeTcpTable;
end;
end.