unit
Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ToolWin, ExtCtrls, XPMan;
type
PMibIfRow = ^TMibIfRow;
TMibIfRow =
packed
record
wszName :
array
[
0..255
]
of
WideChar
;
dwIndex : DWORD;
dwType : DWORD;
dwMtu : DWORD;
dwSpeed : DWORD;
dwPhysAddrLen : DWORD;
bPhysAddr :
array
[
1..8
]
of
Byte
;
dwAdminStatus : DWORD;
dwOperStatus : DWORD;
dwLastChange : DWORD;
dwInOctets : DWORD;
dwInUcastPkts : DWORD;
dwInNUCastPkts : DWORD;
dwInDiscards : DWORD;
dwInErrors : DWORD;
dwInUnknownProtos : DWORD;
dwOutOctets : DWORD;
dwOutUCastPkts : DWORD;
dwOutNUCastPkts : DWORD;
dwOutDiscards : DWORD;
dwOutErrors : DWORD;
dwOutQLen : DWORD;
dwDescrLen : DWORD;
bDescr :
array
[
0..255
]
of
Char
;
end
;
pMibIfArray = ^TMIBIFARRAY;
TMibIfArray =
array
[
0..512
]
of
TMibIfRow;
PMibIfTable = ^TMibIfTable;
TMibIfTable =
packed
record
dwNumEntries : DWORD;
Table : TMibIfArray;
end
;
TMacAddress=
array
[
1..8
]
of
byte
;
type
TForm1 =
class
(TForm)
ListView1: TListView;
Bevel1: TBevel;
Timer1: TTimer;
XPManifest1: TXPManifest;
procedure
Timer1Timer(Sender: TObject);
private
function
GetStrMac(Mac:TMacAddress; size:
integer
):
string
;
function
GetInterfaceType (types:
integer
):
string
;
function
Traff(count:
integer
):
string
;
function
SpeedToStr(value:dword):
string
;
public
end
;
var
Form1: TForm1;
function
GetIfTable(pIfTable:PMibIfTable; pdwSize: PULONG;
bOrder:
boolean
): DWORD; stdCall; external
'IPHLPAPI.DLL'
;
implementation
{$R *.dfm}
function
TForm1
.
GetInterfaceType(types:
integer
):
string
;
begin
Result:=
'Неизвестно'
;
case
types
of
1
: Result:=
'Other'
;
6
: Result:=
'Ethernet'
;
9
: Result:=
'Token ring'
;
23
: Result:=
'PPP'
;
24
: Result:=
'Loopback'
;
37
: Result:=
'ATM'
;
71
: Result:=
'IEEE 802.11'
;
131
: Result:=
'Tunnel'
;
144
: Result:=
'IEEE 1394 (Firewire)'
;
end
;
end
;
function
TForm1
.
GetStrMac(Mac: TMacAddress; size:
integer
):
string
;
var
i:
integer
;
begin
if
size =
0
then
begin
result:=
'00-00-00-00-00-00'
;
Exit;
end
;
Result:=
''
;
for
i:=
1
to
size
do
Result:=Result+IntToHex(Mac[i],
2
)+
'-'
;
Delete(Result, length(Result),
1
);
end
;
function
TForm1
.
SpeedToStr(value: dword):
string
;
const
KB=
1000
;
MB=KB*
1000
;
GB=MB*
1000
;
begin
if
Value<KB
then
Result:=FormatFloat(
'#,##0.00 bps'
,Value)
else
if
Value<MB
then
Result:=FormatFloat(
'#,##0.00 Kbps'
, Value/KB)
else
if
Value<GB
then
Result:=FormatFloat(
'#,##0.00 Mbps'
, Value/MB)
end
;
procedure
TForm1
.
Timer1Timer(Sender: TObject);
var
_MibIfTable:PMibIfTable;
_P:
Pointer
;
i:
integer
;
_buflen:dword;
_error:dword;
begin
listview1
.
Items
.
Clear;
_buflen:=sizeof(_MibIfTable^);
New(_MibIfTable);
_P:=_MibIfTable;
_error:=GetIfTable(_MibIfTable, @_buflen,
false
);
if
_error <> NO_ERROR
then
begin
ShowMessage(
'Произошла ошибка!'
);
Exit;
end
;
for
i:=
0
to
TMibIfTable(_P^).dwNumEntries-
1
do
with
ListView1
.
Items
.
Add
do
begin
caption:=Trim(TMibIfTable(_p^).table[i].bDescr);
subitems
.
Add(GetInterfaceType(TMibIfTable(_P^).table[i].dwtype));
subitems
.
Add(GetStrMac(TMacAddress(TMibIfTable(_p^).Table[i].bPhysAddr),TMibIfTable(_p^).table[i].dwPhysAddrLen));
subitems
.
add(SpeedToStr(TMibIfTable(_p^).table[i].dwSpeed));
subitems
.
Add(Traff(TMibIfTable(_p^).table[i].dwOutOctets));
subitems
.
Add(Traff(TMibIfTable(_p^).table[i].dwInOctets));
subitems
.
Add(IntToStr(TMibIfTable(_p^).table[i].dwOutErrors));
subitems
.
Add(IntToStr(TMibIfTable(_p^).table[i].dwInErrors));
end
;
dispose(_MibIfTable);
end
;
function
TForm1
.
Traff(count:
integer
):
string
;
const
KB=
1024
;
MB=KB*
1024
;
GB=MB*
1024
;
begin
if
Count<KB
then
Result:=FormatFloat(
'#,##0.00 B'
, count)
else
if
count<MB
then
Result:=FormatFloat(
'#,##0.00 KB'
, count/KB)
else
if
count<GB
then
Result:=FormatFloat(
'#,##0.00 MB'
, count/MB);
end
;
end
.