title image


Smiley Kein Problem ...
unit unitMain;



interface



uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, unitTCP,

StdCtrls;



type

TForm1 = class(TForm)

ListBox1: TListBox;

procedure FormCreate(Sender: TObject);

private

{ Private-Deklarationen }

public

{ Public-Deklarationen }

end;



var

Form1: TForm1;





{$R *.DFM}



const MAX_INTERFACE_NAME_LEN:integer=256;

const MAX_INTERFACE_NAME_LEN2m1:integer=511;

const MAXLEN_PHYSADDR:integer=8;

const MAXLEN_IFDESCR:integer=256;



// -----------------------------------TCP Stats ---------------------

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;



// -----------------------------------UDP Stats ---------------------

Type TMIB_UDPROW = record

dwLocalAddr : String; //address on local computer

dwLocalPort : String; //port number on local computer

End;









// Die Struktur eines IFRow-Tables (TMIB_IFROW) - wird für jedes Interface erstellt

type

TMIB_IFROW = record

wszName : array [0 .. 511] of byte;

dwIndex : cardinal; // index of the interface

dwType : Longint ;// type of interface

dwMtu : Longint ;// max transmission unit

dwSpeed : Longint ;// speed of the interface

dwPhysAddrLen : Longint ;// length of physical address

bPhysAddr : array [0 .. 7] of byte ;// physical address of adapter

dwAdminStatus : Longint ;// administrative status

dwOperStatus : Longint ;// operational status

dwLastChange : Longint ;// last time operational status changed

dwInOctets : Longint ;// octets received

dwInUcastPkts : Longint ;// unicast packets received

dwInNUcastPkts : Longint ;// non-unicast packets received

dwInDiscards : Longint ;// received packets discarded

dwInErrors : Longint ;// erroneous packets received

dwInUnknownProtos : Longint ;// unknown protocol packets received

dwOutOctets : Longint ;// octets sent

dwOutUcastPkts : Longint ;// unicast packets sent

dwOutNUcastPkts : Longint ;// non-unicast packets sent

dwOutDiscards : Longint ;// outgoing packets discarded

dwOutErrors : Longint ;// erroneous packets sent

dwOutQLen : Longint ;// output queue length

dwDescrLen : Longint ;// length of bDescr member

bDescr :array[0 .. 255] of char ;// interface description

End;



Type TMIB_UDPTABLE = record

dwNumEntries : Longint; //number of entries in the table

table : array [0..100] of TMIB_UDPROW; //table of MIB_UDPROW structs

End;



type

// Struktur des IfTables

TifTable = record

nRows : LongInt; // Anzahl Interfaces

ifRow : array[1..20]of TMIB_IFROW; // mehr als 20 sollten es aber nicht sein!

end;



// den TCP-Table holen

function GetTcpTable (pTcpTable: Pointer; var pdwSize : Longint; bOrder : Longint): Longint;stdcall;

function GetTcpTable; external 'iphlpapi' name 'GetTcpTable';



// den UDP-Table holen

function GetUdpTable (pUdpTable: Pointer; var pdwSize : Longint; bOrder : Longint): Longint;stdcall;

function GetUdpTable; external 'iphlpapi' name 'GetUdpTable';



// Einbinden der Funktion aus iphlpapi, um empfangene und gesendete Bytes und die Interfaces-Stats zu holen

function GetIfTable(pIfRowTable: Pointer ; var pdwSize : Longint; bOrder : LongInt): Longint;stdcall;

function GetIfTable; external 'iphlpapi' name 'GetIfTable';



function _getIP(var addr) : string;

function _getPort(var addr) : word;

function _getTCPState(status : integer) : string;





implementation





function _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 _getPort(var addr) : word;

var daten : array[0..3] of byte absolute addr;

begin

result := Daten[0]*256+daten[1];

end;



// Um unsere Ausgaben zu vervollständigen, bedarf es noch einer Hilfsstruktur, die die jeweiligen Zustände einer TCP-Verbindung charakerisiert:

// TCP-States...

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;



// und die Funktion, die das ganze formatiert ausgibt:

function _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.FormCreate(Sender: TObject);

var m_pTcpTable : ^TMIB_TCPTABLE;

var i : integer;

var cCode:integer;

var

// einige Hilfsstrukturen...

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

end;

tmp : String;

begin

m_pTcpTable := nil;

ZeroMemory(@L,sizeof(L));



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

exit;

end;

ListBox1.Clear;

for i:= 0 to m_pTcpTable.dwNumEntries-1 do begin

tmp:='';

tmp:=tmp+_getIP(m_pTcpTable.table[i].dwLocalAddr)+':'+IntToStr(_getPort(m_pTcpTable.table[i].dwLocalPort));

tmp:=tmp+' - ';

tmp:=tmp+_getIP(m_pTcpTable.table[i].dwRemoteAddr)+':'+IntToStr(_getPort(m_pTcpTable.table[i].dwRemotePort));

tmp:=tmp+' - ';

tmp:=tmp+_getTCPState(m_pTcpTable.table[i].dwState);

ListBox1.Items.Add(tmp);

end;

end;



end.



Jetzt nur noch nach deinen Bedürfnissen den Code anpassen

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: