1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls;
const MAX_INTERFACE_NAME_LEN = $100; // maximale Länge Name des Interfaces const MAXLEN_PHYSADDR = 8; // maximale Länge der physischen Adresse const MAXLEN_IFDESCR = $100; // maximale Länge Beschreibung des Int. // Die Struktur eines IFRow-Tables - wird für jedes Interface erstellt type TMIB_IFROW = record wszName : array [0 .. (MAX_INTERFACE_NAME_LEN*2-1)] 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 .. (MAXLEN_PHYSADDR-1)] 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 .. (MAXLEN_IFDESCR-1)] of char ;// interface description End;
// 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;
// -----------------------------------für die IPs --------------------- type _MIB_IPADDRROW = packed record dwAddr: DWORD; // IP address dwIndex: DWORD; // interface index dwMask: DWORD; // subnet mask dwBCastAddr: DWORD; // broadcast address dwReasmSize: DWORD; // re-assembly size unused: WORD; // not currently used unused2: WORD; // not currently used end; TMib_IpAddrRow = _MIB_IPADDRROW; PMib_IpAddrRow = ^TMib_IpAddrRow;
_MIB_IPADDRTABLE = packed record dwNumEntries: DWORD; // number of entries in the table table: array[0..0] of TMib_IpAddrRow; // array of IP address entries end; TMib_IpAddrTable = _MIB_IPADDRTABLE; PMib_IpAddrTable = ^TMib_IpAddrTable;
type TForm1 = class(TForm) Button1: TButton; RichEdit1: TRichEdit; procedure Button1Click(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } pIfTable : ^TifTable; // ein Pointer auf eine Interfacetabelle 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; tmp : String; end; end; // für IPs function GetIpAddrTable(ipAddrTable: PMIB_IPADDRTABLE; var dwSize: ULONG; bOrder: BOOL): Integer; stdcall; external 'iphlpapi.dll';
// Einbinden der Funktion aus iphlpapi, um die Interfaces-Stats zu holen function GetIfTable(pIfRowTable: Pointer ; var pdwSize : Longint; bOrder : LongInt): Longint;stdcall; function GetIfTable; external 'iphlpapi.dll' name 'GetIfTable';
var Form1: TForm1; cCode : Word; implementation function IntToIp(Ip: Cardinal): string; type TIpRec = record n1, n2, n3, n4: Byte; end; begin with TIpRec(Ip) do Result := Format('%d.%d.%d.%d', [n1, n2, n3, n4]); end;
function GetAdress(index : DWORD) : DWORD; var Size: longint; IpAddrTable: PMib_IpAddrTable; i: Integer; begin Size := 0; GetIpAddrTable(nil, Size, True); if Size > 0 then begin GetMem(IpAddrTable, Size); try if GetIpAddrTable(IpAddrTable, Size, True) = ERROR_SUCCESS then begin for i := 0 to IpAddrTable^.dwNumEntries -1 do begin if (index = IpAddrTable^.table[i].dwIndex) then begin result := IpAddrTable^.table[i].dwAddr; end ; end; end; finally FreeMem(IpAddrTable); end; end; end;
function MacAdresse (VAR Addr) : String; var daten : array[0..5] of byte absolute Addr; begin Result := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[Daten[0],daten[1],Daten[2],Daten[3],Daten[4]]) end; {$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
// Die Windwos Error Messages...
const ERROR_NOT_SUPPORTED = $50; const ERROR_INSUFFICIENT_BUFFER = 122 ; const ERROR_INVALID_PARAMETER = 87 ;
var i : integer; begin pIfTable := nil; Richedit1.Clear ; ZeroMemory(@L, sizeof(L)); // schauen, wie gross die Tabelle ist.. cCode := GetIfTable(pIfTable, L.cbRequired,1);
if (L.cbRequired <=0) or (L.cbRequired>sizeof(TifTable)) then exit;
// Mem allokieren und IP-Table empfangen... GetMem(pIfTable, L.cbRequired); ZeroMemory(pIfTable, L.cbrequired); cCode := GetIfTable(pIfTable, L.cbRequired, 1);
if cCode <> ERROR_SUCCESS then begin showmessage ('Fehler beim Funktionsaufruf') ; exit; end; richedit1.Lines.clear;
for i:= 1 to pIfTable^.nRows do begin richedit1.Lines.add(StrPas(@pIfTable^.ifRow[i].bDescr)); L.tmp := MacAdresse(pifTable^.ifRow[i].bPhysAddr); L.tmp := Format ('phys Add.: %s', [L.tmp]); richedit1.Lines.Add(L.tmp); richedit1.Lines.Add('IP: ' + InttoIp(getAdress(pIfTable^.ifRow[i].dwIndex))); richedit1.Lines.add(''); end; end; end. |