Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.07.2013, 13:32   #1
calypso
Форумчанин
 
Регистрация: 02.12.2012
Сообщений: 250
По умолчанию Не работает код получения информации о сетевом адаптере,структура MIB_IFROW

Код придумал не сам,а переделал немного готовый из сети.Но не работает (ихнее скомпилированное приложение под Delphi7 работает).
Код:
unit Unit8;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
const
  MAX_ADAPTER_NAME_LENGTH        = 256;
  MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
  MAX_ADAPTER_ADDRESS_LENGTH     = 8;
  MAXLEN_IFDESCR         = 256;

type
IP_ADDRESS_STRING = record
    S: array [0..15] of Char;
  end;
  IP_MASK_STRING = IP_ADDRESS_STRING;
  PIP_MASK_STRING = ^IP_MASK_STRING;

   PIP_ADDR_STRING = ^IP_ADDR_STRING;
  IP_ADDR_STRING = record
    Next: PIP_ADDR_STRING;
    IpAddress: IP_ADDRESS_STRING;
    IpMask: IP_MASK_STRING;
    Context: DWORD;
  end;

  PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
  IP_ADAPTER_INFO = record
    Next: PIP_ADAPTER_INFO;
    ComboIndex: DWORD;
    AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of Char;
    Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of Char;
    AddressLength: UINT;
    Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
    Index: DWORD;
    Type_: UINT;
    DhcpEnabled: UINT;
    CurrentIpAddress: PIP_ADDR_STRING;
    IpAddressList: IP_ADDR_STRING;
    GatewayList: IP_ADDR_STRING;
    DhcpServer: IP_ADDR_STRING;
    HaveWins: BOOL;
    PrimaryWinsServer: IP_ADDR_STRING;
    SecondaryWinsServer: IP_ADDR_STRING;
    LeaseObtained: Longint;
    LeaseExpires: Longint;
  end;

  type MIB_IFROW=record
  wszName           :  array[1..MAX_ADAPTER_NAME_LENGTH] of WCHAR;
  // A pointer to a Unicode string that contains the name of the interface
  dwIndex           :  DWORD;
  // The index that identifies the interface.
  //This index value may change when a network adapter is disabled and then enabled, and should not be considered persistent
  dwType            :  DWORD;
  // The interface type as defined by the Internet Assigned Names Authority (IANA).
  // Possible values for the interface type are listed in the Ipifcons.h header file.
  dwMtu             :  DWORD;
  // The Maximum Transmission Unit (MTU) size in bytes
  dwSpeed           :  DWORD;
  // The speed of the interface in bits per second.
  dwPhysAddrLen     :  DWORD;
  // The length, in bytes, of the physical address specified by the bPhysAddr member.
  bPhysAddr         :  array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;
  // The physical address of the adapter for this interface.
  dwAdminStatus     :  DWORD;
  // The interface is administratively enabled or disabled.
  dwOperStatus      :  DWORD;
  // The operational status of the interface. This member can be one of the following values
  // defined in the INTERNAL_IF_OPER_STATUS enumeration defined in the Ipifcons.h header file.
  dwLastChange      :  DWORD;
  // The length of time, in hundredths of seconds (10^-2 sec),
  // starting from the last computer restart, when the interface entered
  // its current operational state. This value rolls over after 2^32 hundredths of a second.
  dwInOctets        :  DWORD;
  // The number of octets of data received through this interface
  dwInUcastPkts     :  DWORD;
  // The number of unicast packets received through this interface.
  dwInNUcastPkts    :  DWORD;
  // The number of non-unicast packets received through this interface.
  // Broadcast and multicast packets are included.
  dwInDiscards      :  DWORD;
  // The number of incoming packets that were discarded even though they did not have errors.
  dwInErrors        :  DWORD;
  // The number of incoming packets that were discarded because of errors.
  dwInUnknownProtos :  DWORD;
  // The number of incoming packets that were discarded because the protocol was unknown
  dwOutOctets       :  DWORD;
  // The number of octets of data sent through this interface
  dwOutUcastPkts    :  DWORD;
  // The number of unicast packets sent through this interface.
  dwOutNUcastPkts   :  DWORD;
  //  The number of non-unicast packets sent through this interface.
  // Broadcast and multicast packets are included.
  dwOutDiscards     :  DWORD;
  // The number of outgoing packets that were discarded even though they did not have errors
  dwOutErrors       :  DWORD;
  // The number of outgoing packets that were discarded because of errors
  dwOutQLen         :  DWORD;
  // The transmit queue length. This field is not currently used
  dwDescrLen        :  DWORD;
  // The length, in bytes, of the bDescr member.
  bDescr            :  array[1..MAXLEN_IFDESCR] of char;
  // A description of the interface
end;
  PMIB_IFROW=^MIB_IFROW;

  TForm8 = class(TForm)
<...>

var
  Form8: TForm8;
  netspeed,netcardname,ipaddress:string;
implementation
calypso вне форума Ответить с цитированием
Старый 30.07.2013, 13:33   #2
calypso
Форумчанин
 
Регистрация: 02.12.2012
Сообщений: 250
По умолчанию

продолжение кода:
Код:
{$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 увидит
calypso вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
функций WinApi для получения системной информации!!! Amoled Win Api 7 10.04.2012 10:00
Получить информацию о сетевом адаптере Энджи Работа с сетью в Delphi 10 29.03.2012 21:21
Информации о сетевом устройстве в linux Morgusha Linux (Ubuntu, Debian, Red Hat, CentOS, Mint) 1 07.11.2011 09:41
Не работает принтер в сетевом режиме zazic2p Компьютерное железо 6 23.05.2011 13:50
Не работает на сетевом диске Andrey85 Работа с сетью в Delphi 0 02.12.2010 14:47