unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Contnrs;
type
TNetworkCard =
class(TObject)
private
FKey:
string;
FStatus: Integer;
FIPAddresses: TStrings;
function GetStatusAsText:
string;
public
constructor Create;
destructor Destroy;
override;
property Key:
string read FKey
write FKey;
property Status: Integer
read FStatus
write FStatus;
property StatusAsText:
string read GetStatusAsText;
property IPAddresses: TStrings
read FIPAddresses;
end;
TNetworkCards =
class(TObject)
private
FItems: TObjectList;
function GetItems(
Index: Integer):TNetworkCard;
function GetCount:Integer;
public
constructor Create;
destructor Destroy;
override;
procedure Add(AItem: TNetworkCard);
procedure Clear;
procedure SetIPAddresses(
const AKey:
string;AAddresses: TStrings);
property Items[
Index: Integer]:TNetworkCard
read GetItems;
default;
property Count: Integer
read GetCount;
end;
TForm1 =
class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure GetNetworkStatus(ACards: TNetworkCards);
procedure GetNetworkAddress(ACards: TNetworkCards);
public
FNetworkCards: TNetworkCards;
FLocator: OleVariant;
FRoot: OleVariant;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ActiveX, ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var cnt: Integer;
begin
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
FNetworkCards.Clear;
FLocator := CreateOleObject('
WbemScripting.SWbemLocator');
FRoot := FLocator.ConnectServer('
.', '
root\cimv2');
try
GetNetworkStatus(FNetworkCards);
GetNetworkAddress(FNetworkCards);
for cnt := 0
to FNetworkCards.Count - 1
do
with FNetworkCards[cnt]
do begin
Memo1.Lines.Add(StatusAsText);
Memo2.Lines.Add(IPAddresses.CommaText);
Memo3.Lines.Add(Format('
%s <-> %s <-> %s', [Key, StatusAsText, IPAddresses.CommaText]));
end;
finally
FRoot := NULL;
FLocator := NULL;
end;
end;
procedure TForm1.GetNetworkAddress(ACards: TNetworkCards);
var
instances: OleVariant;
item: OleVariant;
ipadd: OleVariant;
enum: IEnumVariant;
ret: Cardinal;
tmp: TStringList;
cnt: Integer;
begin
tmp := TStringList.Create;
instances := FRoot.InstancesOf('
Win32_NetworkAdapterConfiguration');
try
enum := IEnumVariant(IUnknown(instances._NewEnum));
while enum.Next(1, item, ret) = S_OK
do begin
ipadd := item.IPAddress;
if VarIsArray(ipadd)
then
for cnt := VarArrayLowBound(ipadd,1)
to VarArrayHighBound(ipadd,1)
do
tmp.Add(VarToStr(ipadd[cnt]));
ACards.SetIPAddresses(VarToStr(item.Caption), tmp);
item := NULL;
end;
finally
enum :=
nil;
instances := NULL;
tmp.Free;
end;
end;
procedure TForm1.GetNetworkStatus(ACards: TNetworkCards);
var
instances: OleVariant;
item: OleVariant;
enum: IEnumVariant;
ret: Cardinal;
nIt: TNetworkCard;
begin
instances := FRoot.InstancesOf('
Win32_NetworkAdapter');
try
enum := IEnumVariant(IUnknown(instances._NewEnum));
while enum.Next(1, item, ret) = S_OK
do begin
nIt := TNetworkCard.Create;
nIt.Key := VarToStr(item.Caption);
nIt.Status := StrToIntDef(VarToStr(item.NetConnectionStatus), -1);
ACards.Add(nIt);
item := NULL;
end;
finally
enum :=
nil;
instances := NULL;
end;
end;
{ TNetworkCard }
constructor TNetworkCard.Create;
begin
inherited Create;
FIPAddresses := TStringList.Create;
end;
destructor TNetworkCard.Destroy;
begin
FreeAndNil(FIPAddresses);
inherited Destroy;
end;
function TNetworkCard.GetStatusAsText:
string;
begin
case FStatus
of
0: Result := '
Disconnected';
1: Result := '
Connecting';
2: Result := '
Connected';
3: Result := '
Disconnecting';
4: Result := '
Hardware not present';
5: Result := '
Hardware disabled';
6: Result := '
Hardware malfunction';
7: Result := '
Media disconnected';
8: Result := '
Authenticating';
9: Result := '
Authentication succeeded';
10: Result := '
Authentication failed';
else
Result := '
unknown'
end;
end;
{ TNetworkCards }
constructor TNetworkCards.Create;
begin
inherited Create;
FItems := TObjectList.Create;
end;
destructor TNetworkCards.Destroy;
begin
FreeAndNil(FItems);
inherited Destroy;
end;
procedure TNetworkCards.Add(AItem: TNetworkCard);
begin
FItems.Add(AItem);
end;
procedure TNetworkCards.Clear;
begin
FItems.Clear;
end;
function TNetworkCards.GetCount: Integer;
begin
Result := FItems.Count;
end;
function TNetworkCards.GetItems(
Index: Integer): TNetworkCard;
begin
Result := FItems[
Index]
as TNetworkCard;
end;
procedure TNetworkCards.SetIPAddresses(
const AKey:
string;AAddresses: TStrings);
var cnt: Integer;
begin
for cnt := 0
to FItems.Count - 1
do
if AnsiSameText(TNetworkCard(FItems[cnt]).FKey, AKey)
then begin
TNetworkCard(FItems[cnt]).IPAddresses.Assign(AAddresses);
Break;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FNetworkCards := TNetworkCards.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FNetworkCards);
end;
end.