продолжение кода:
Код:
{$R *.dfm}
uses Unit2;
// При помощи данной функции мы определим наличие сетевых интерфейсов
// на локальном компьютере и информацию о них
function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO;
var pOutBufLen: ULONG): DWORD; stdcall; external 'iphlpapi.dll';
// GetIfEntry function retrieves information for the specified interface on the local computer.
//Иными словами,эта функция должна заполнять структуру MIB_IFROW
function GetIfEntry(PMib_IfRow:PMIB_IFROW):DWORD ; stdcall ; external 'IPHLPAPI.DLL';
//Перевод килобитов и мегабитов (нужно будет допиливать)
function BitsToFriendlyString(Value : DWord) : string;
const
OneKB=1000;
OneMB=OneKB*1000;
OneGB=OneMB*1000;
begin
if Value<OneKB
then Result:=FormatFloat('#,##0.00 bps',Value)
else
if Value<OneMB
then Result:=FormatFloat('#,##0.00 Kbps', Value/OneKB)
else
if Value<OneGB
then Result:=FormatFloat('#,##0.00 Mbps', Value/OneMB)
end;
//Функция для определения размера данных входящего и исходящего пакета
procedure ReadLanInterfacesPaket(List:TStrings; IndexLan: Integer);
var
InterfaceInfo: PMIB_IFROW;
begin
GetMem(InterfaceInfo, SizeOf(MIB_IFROW));
try
InterfaceInfo^.dwIndex:=IndexLan;
if GetIfEntry(InterfaceInfo) = ERROR_SUCCESS then
begin
List.Add(Format('Вх. %s',[BitsToFriendlyString(InterfaceInfo^.dwInUcastPkts)]));
List.Add(Format('Исх. %s',[BitsToFriendlyString(InterfaceInfo^.dwOutUcastPkts)]));
//List.Add(Format('Скорость %s',[BitsToFriendlyString(InterfaceInfo^.dwSpeed)]));
netspeed:=BitsToFriendlyString(InterfaceInfo^.dwSpeed);
end;
finally
// Освобождаем занятую память
FreeMem(InterfaceInfo);
end;
end;
// Читаем все IP адреса со всех присутствующих
// в системе сетевых интерфейсов
procedure ReadLanInterfaces(List:TStrings; IndexLan: Integer=-1);
var
InterfaceInfo,
TmpPointer: PIP_ADAPTER_INFO;
IP: PIP_ADDR_STRING;
Len: ULONG;
IndexAddress : byte;
AddressMACTemp: string;
begin
// Смотрим сколько памяти нам требуется?
if GetAdaptersInfo(nil, Len) = ERROR_BUFFER_OVERFLOW then
begin
// Берем нужное кол-во
GetMem(InterfaceInfo, Len);
FillChar(InterfaceInfo^, Len, 0);
try
InterfaceInfo.Index:=1;
// выполнение функции
if GetAdaptersInfo(InterfaceInfo, Len) = ERROR_SUCCESS then
begin
// Перечисляем все сетевые интерфейсы
TmpPointer := InterfaceInfo;
repeat
// перечисляем все IP адреса каждого интерфейса
IP := @TmpPointer^.IpAddressList;
repeat
if IndexLan = -1 then
ShowMessage(Format('%s Index:%d',[IP^.IpAddress.S, IP^.Context]));
if IndexLan = IP^.Context then
begin
//List.Add(Format('Адрес:%s',[IP^.IpAddress.S]));
ipaddress:=IP^.IpAddress.S;
ShowMessage(Format('Маска:%s',[IP^.IpMask.S]));
ShowMessage(Format('Шлюз:%s',[TmpPointer^.GatewayList.IpAddress.S]));
ShowMessage(Format('DHCP:%s',[TmpPointer^.DhcpServer.IpAddress.s]));
//определяем MAC адрес
for IndexAddress:=0 to TmpPointer^.AddressLength -1 do
begin
AddressMACTemp:=AddressMACTemp+IntToHex(TmpPointer^.Address[IndexAddress],2);
if IndexAddress < TmpPointer^.AddressLength -1 then
AddressMACTemp:=AddressMACTemp+'-';
end;
if AddressMACTemp='' then
ShowMessage('MAC: N/A')
else
ShowMessage(Format('MAC: %s',[AddressMACTemp]));
//List.Add(TmpPointer^.Description);
netcardname:=TmpPointer^.Description;
end;
IP := IP.Next;
until IP = nil;
TmpPointer := TmpPointer.Next;
until TmpPointer = nil;
end
// Смотрим - можем ли мы продолжать работу программы?
else ShowMessage('Ошибка при вызове GetAdaptersInfo');
finally
// Освобождаем занятую память
FreeMem(InterfaceInfo);
end;
end;
end;
procedure TForm8.FormCreate(Sender: TObject);
begin
ReadLanInterfaces(ComboBox1.Items);
Label5.Caption:=ipaddress;
Label15.Caption:=netspeed;
Label17.Caption:=netcardname;
end;
end.
Этот код либо вообще не работает (не видит адаптеры и выдает Index=0),либо в зависимости от конфигурации системы прога падает с ошибкой (мне показалось,если в компе более 1 сетевой карты, с VMware адаптером тоже падает). Но для начала пусть хоть 1 сетевку realtek увидит