1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSock, ExtCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    function DetectHostIP: boolean;
  end;

var
  Form1: TForm1;
  HostIP:String='Unknown';


implementation

{$R *.dfm}

function TForm1.DetectHostIP: Boolean;
var
  wsdata: TWSAData;
  hostname: array[0..255] of char;
  hostEnt: PHostEnt;
  addr: PChar;
begin
  WSAStartup($0101,wsdata);
  try
    gethostname(hostname,sizeof(hostname));
    hostEnt := gethostbyname(hostname);
    if Assigned(hostEnt) then
      if Assigned(hostEnt^.h_addr_list) then
        begin
          addr := hostEnt^.h_addr_list^;
          if Assigned(addr) then
            begin
              HostIP := Format('%d.%d.%d.%d',[byte(addr[0]),byte(addr[1]),byte(addr[2]),byte(addr[3])]);
              Result := True;
            end
          else
            Result := False;
        end
      else
        Result := False
    else
      begin
        MessageDlg(Format('WinSock Error %d', [WSAGetLastError]),mtError,[mbOK],0);
        Result := False;
      end;
  finally
    WSACleanup;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if DetectHostIP=True then ShowMessage(HostIP);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if DetectHostIP=True then
    if HostIP <> '127.0.0.1' then
      CheckBox1.Checked := True //CheckBox sagt: Netzwerkkabel steckt
    else
      CheckBox1.Checked := False;  //oder halt net
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:

unit UNetWMI;

interface

uses
   // Delphi VCL Units
   Classes, Variants;

   // external forward declarations
   function getSystemMACAddresses: TStringList;

implementation

uses
   // Delphi VCL Units
   Windows,
   Dialogs,
   ComObj,
   ActiveX,
   // Imported type libraries
   WbemScripting_TLB;   { Typelib name: "Microsoft Windows WMI Scripting V1.2 Library" }

const
   // define used constants
   WMI_LOCAL_COMPUTER   = '.';
   WMI_SYSTEM_NAMESPACE = 'root\CIMV2';
   WMI_CLASS_NIC        = 'Win32_NetworkAdapter';
   WMI_ATTRIB_ADAPTER   = 'AdapterType';
   WMI_ATTRIB_AVAILAB   = 'NetConnectionID';
   WMI_ATTRIB_CONNSTAT  = 'NetConnectionStatus';
   WMI_ATTRIB_MAC       = 'MACAddress';
   WMI_ATTRIB_NAME      = 'Name';

// retrieve System MAC Addresses via WMI
//
function getSystemMACAddresses: TStringList;
var
   l_WMILocator:          ISWbemLocator;     // Locator, gets Services
   l_WMIServices:         ISWbemServices;    // Services, gets Object Definitions
   l_WMIObjectDefinition: ISWbemObject;      // Definition, gets Set of Objetcs
   l_WMIObjectSet:        SWbemObjectSet;    // ObjectSet, gets Enum over Instances
   l_WMIObjectInstances:  IEnumVariant;      // Enum of Instances, gets Object
   l_WMIObject:           ISWbemObject;      // Object, gets Sets of his properties
   l_WMIPropertySet:      ISWbemPropertySet; // PropertySet, gets single property
   l_WMIProperty:         ISWbemProperty;    // Property, gets Value

   l_TempObj:             OleVariant;        // temporary used values
   l_ObjValue:            Cardinal;
begin
   // create the return object
   result := TStringList.Create;

   // retrieve object enum through WMI classes
   l_WMILocator := CoSWbemLocator.Create;
   l_WMIServices := L_WMILocator.ConnectServer(WMI_LOCAL_COMPUTER, WMI_SYSTEM_NAMESPACE, '', '', '', '', 0, nil);
   l_WMIObjectDefinition := l_WMIServices.Get(WMI_CLASS_NIC, wbemFlagUseAmendedQualifiers, nil);
   l_WMIObjectSet := l_WMIObjectDefinition.Instances_(0, nil);
   l_WMIObjectInstances := (l_WMIObjectSet._NewEnum) as IEnumVariant;

   // iterate through enum values (WbemObjects) and get the property values
   while (l_WMIObjectInstances.Next(1, l_TempObj, l_ObjValue) = S_OK) do
   begin
      l_WMIObject:= IUnknown(l_TempObj) as SWBemObject;

      l_WMIPropertySet := l_WMIObject.Properties_;

      l_WMIProperty := l_WMIPropertySet.Item(WMI_ATTRIB_AVAILAB, 0);
      if not VarIsNull(l_WMIProperty.Get_Value) then
        begin
          result.Add(l_WMIProperty.Get_Value);
          l_WMIProperty := l_WMIPropertySet.Item(WMI_ATTRIB_NAME, 0);
          if not VarIsNull(l_WMIProperty.Get_Value) then
            result.Append(' - '+l_WMIProperty.Get_Value);
          l_WMIProperty := l_WMIPropertySet.Item(WMI_ATTRIB_MAC, 0);
          if not VarIsNull(l_WMIProperty.Get_Value) then
            result.Append(' - '+l_WMIProperty.Get_Value)
          else
            result.Append(' - MAC-Address not available');
          l_WMIProperty := l_WMIPropertySet.Item(WMI_ATTRIB_ADAPTER, 0);
          if not VarIsNull(l_WMIProperty.Get_Value) then
            result.Append(' - '+l_WMIProperty.Get_Value)
          else
            result.Append(' - Network Type not available');
          l_WMIProperty := l_WMIPropertySet.Item(WMI_ATTRIB_CONNSTAT, 0);
          if l_WMIProperty.Get_Value=2 then
            result.Append(' - Status: Connected')
          else
            result.Append(' - Status: NOT Connected');
          result.Add('');
        end;
   end;
end;
end.					

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items := getSystemMACAddresses;
end;