unit UMain;
interface
uses
Windows, SysUtils, Classes, Controls, Forms,
StdCtrls, ComCtrls, IpTypes, IpHlpApi, Dialogs, sComboBox;
type
TFMain = class(TForm)
lv_net: TListView;
sComboBox1: TsComboBox;
sComboBox2: TsComboBox;
sComboBox3: TsComboBox;
procedure lv_netData(Sender: TObject; Item: TListItem);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FMain: TFMain;
gInfoStr:AnsiString;
gsAdaList:TStringList;
LsTempList:TStringList;
implementation
{$R *.dfm}
function GetAdaInfo2(out AInfoStr:AnsiString; const AOnlyMac:Boolean):Boolean;
const
cntAdaCount=2;
cntAdaTypesInt:array[0..cntAdaCount] of Cardinal=($6,$47,$90);
cntAdaTypesDef:array[0..cntAdaCount] of AnsiString=
('Ethernet Network Adapter',
'Wireless Network Adapter',
'FireWire Network Adapter');
var
i:Integer;
bf:Cardinal;
LqFind:Boolean;
LsMac:AnsiString;
LpAdapterAddresses:PIP_ADAPTER_ADDRESSES;
begin
Result:=True;
AInfoStr:='';
try
bf:=0;
if GetAdaptersAddresses(0,0,nil,nil,@bf)<>ERROR_BUFFER_OVERFLOW then Abort;
try
GetMem(LpAdapterAddresses,bf);
if GetAdaptersAddresses(0,0,nil,LpAdapterAddresses,@bf)<>ERROR_SUCCESS then Abort;
while LpAdapterAddresses<>nil do
begin
try
//определяем тип адаптера
LqFind:=False;
for i:=0 to cntAdaCount do
if LpAdapterAddresses^.IfType=cntAdaTypesInt[i] then // i индекс адаптера в сетевом окружении
begin
LqFind:=True;
Break;
end;
if not LqFind then Continue;
//собираем информацию об устройстве // '%s%s (%s)'#13#10'%s'#13#10 маска вывода информации
if not AOnlyMac then
AInfoStr:=Format('%s%s '#13#10'%s'#13#10 , [AInfoStr,LpAdapterAddresses^.FriendlyName,
LpAdapterAddresses^.Description,cntAdaTypesDef[i]]);
LsMac:='';
if LpAdapterAddresses^.PhysicalAddressLength=0 then Continue;
for i:=0 to LpAdapterAddresses^.PhysicalAddressLength-1 do
LsMac:=LsMac+IntToHex(LpAdapterAddresses^.PhysicalAddress[i],2)+'-';
SetLength(LsMac,Length(LsMac)-1);
AInfoStr:=Format('%s%s'#13#10#13#10,[AInfoStr,LsMac]);
finally
LpAdapterAddresses:=LpAdapterAddresses^.Next;
end;
end;
finally
FreeMem(LpAdapterAddresses,bf);
end;
except
Result:=False;
// AInfoStr:='';
end;
end;
{
function GetAdaInfo(out AInfoStr:AnsiString; const AOnlyMac:Boolean):Boolean;
const
cntAdaCount=1;
cntAdaTypesInt:array[0..cntAdaCount] of Cardinal=(6,71);
cntAdaTypesDef:array[0..cntAdaCount] of AnsiString=
('Ethernet Network Adapter',
'Wireless Network Adapter');
var
i:Integer;
bf:Cardinal;
LqFind:Boolean;
LsMac:AnsiString;
LpAdapterInfo:PIP_ADAPTER_INFO;
begin
Result:=True;
AInfoStr:='';
try
bf:=0;
if GetAdaptersInfo(nil,bf)<>ERROR_BUFFER_OVERFLOW then Abort;
try
New(LpAdapterInfo);
if GetAdaptersInfo(LpAdapterInfo,bf)<>ERROR_SUCCESS then Abort;
while LpAdapterInfo<>nil do
begin
try
//определяем тип адаптера
LqFind:=False;
for i:=0 to cntAdaCount do
if LpAdapterInfo^.Type_=cntAdaTypesInt[i] then
begin
LqFind:=True;
Break;
end;
if not LqFind then Continue;
//собираем информацию об устройстве
if not AOnlyMac then
AInfoStr:=Format('%s%s'#13#10'%s'#13#10,
[AInfoStr,LpAdapterInfo^.Description,cntAdaTypesDef[i]]);
LsMac:='';
if LpAdapterInfo^.AddressLength=0 then Continue;
for i:=0 to LpAdapterInfo^.AddressLength-1 do
LsMac:=LsMac+IntToHex(LpAdapterInfo^.Address[i],2)+'-';
SetLength(LsMac,Length(LsMac)-1);
AInfoStr:=Format('%s%s'#13#10#13#10,[AInfoStr,LsMac]);
finally
LpAdapterInfo:=LpAdapterInfo^.Next;
end;
end;
finally
Dispose(LpAdapterInfo);
end;
except
Result:=False;
AInfoStr:='';
end;
end; }
procedure TFMain.lv_netData(Sender: TObject; Item: TListItem);
var
i:Integer;
begin
LsTempList:=TStringList.Create;
LsTempList.Text:=gsAdaList[Item.Index];//добовляет в TList строку
Item.Caption:=LsTempList[0];
sComBobox1.Items.Add(LsTempList[0]);// Добовляем в Combobox наименование адаптора
sComBobox2.Items.Add(LsTempList[1]);
sComBobox3.Items.Add(LsTempList[2]);
Item.SubItems.Add(LsTempList[1]);
Item.SubItems.Add(LsTempList[2]); // добовляем тип адаптера и МАС адрес
/// sCombobox1.Items.Add(LsTempList.Text);
end;
procedure TFMain.FormShow(Sender: TObject);
begin
if not GetAdaInfo2(gInfoStr,False) then Exit;//здесь можно выбрать версию функции
//ShowMEssage(gInfoStr); // Кстати зырь. подключись ко мне.
sCombobox1.Items.Clear;
gsAdaList:=TStringList.Create;
gsAdaList.LineBreak:=#13#10#13#10;
gsAdaList.Text:=gInfoStr;
lv_net.AllocBy:=gsAdaList.Count;
end;
procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(gsAdaList);
end;
end.