Gehe zu deutscher Webseite

ViaThinkSoft CodeLib

This article is in:
CodeLibProgramming aidsDelphi


uses
  WinSock, ActiveX, ComObj;

function OleVariantToText(aVar:OleVariant):string;
// mostly quickdump for WMI researchpurposes
var
    i : integer;
begin
  Result:='';
  if not VarIsNull(aVar) then
    if VarIsArray(aVar) then
      begin
        result:='{';
        for i :=VarArrayLowBound(aVar,1) to vararrayhighbound(aVar,1)  do
          begin
            if i<>0 then
              result:=result+',';
            result:=result+OleVariantToText(vararrayget(aVar,[i]));
          end;
        result:=result+'}';
      end
    else
      Result:=VarToStr(aVar);
end;

Function GetMultiString_FromArray( ArrayString:OleVariant; separator:string):string;
begin
    If varisnull ( ArrayString ) Then
        result:= ''
    else
        result := OleVariantToText(arraystring); // arraystring.items[0]; // Join( ArrayString, Seprator )
end;

function GetWMIObject(const objectName: String): IDispatch;
var
  chEaten: Integer;
  BindCtx: IBindCtx;//for access to a bind context
  Moniker: IMoniker;//Enables you to use a moniker object
begin
  OleCheck(CreateBindCtx(0, bindCtx));
  OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));//Converts a string into a moniker that identifies the object named by the string
  OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));//Binds to the specified object
end;

function GetWMIarray(wmiHost, root, wmiClass, wmiProperty, Separator: string): string;
var
  objWMIService : OLEVariant;
  colItems      : OLEVariant;
  colItem       : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin
  objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
  colItems      := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
  oEnum         := IUnknown(colItems._NewEnum) as IEnumVariant;
  while oEnum.Next(1, colItem, iValue) = 0 do
  begin
     Result:=GetMultiString_FromArray(colItem.Properties_.Item(wmiProperty, 0).Value,Separator); //you can improve this code  ;) , storing the results in an TString.
     if Result <> '' then break;
  end;
end;

function GetWMIstring(wmiHost, root, wmiClass, wmiProperty: string): string;
var
  objWMIService : OLEVariant;
  colItems      : OLEVariant;
  colItem       : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin
  objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
  colItems      := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
  oEnum         := IUnknown(colItems._NewEnum) as IEnumVariant;
  while oEnum.Next(1, colItem, iValue) = 0 do
  begin
     Result:=colItem.Properties_.Item(wmiProperty, 0); //you can improve this code  ;) , storing the results in an TString.
     if Result <> '' then break;
  end;
end;

function SendArp(DestIP,SrcIP:ULONG;pMacAddr:pointer;PhyAddrLen:pointer) : DWord; StdCall; external 'iphlpapi.dll' name 'SendARP';

function GetRouterMac(debug: boolean=false): string;

  function GetMacAddr(const IPAddress: string; var ErrCode : DWORD): string;
  var
    MacAddr    : Array[0..5] of Byte;
    DestIP     : ULONG;
    PhyAddrLen : ULONG;
    WSAData    : TWSAData;
  begin
    // https://stackoverflow.com/questions/4550672/delphi-get-mac-of-router
    Result    :='';
    WSAStartup($0101, WSAData);
    try
      ZeroMemory(@MacAddr,SizeOf(MacAddr));
      DestIP    :=inet_addr(PAnsiChar(AnsiString(IPAddress)));
      PhyAddrLen:=SizeOf(MacAddr);
      ErrCode   :=SendArp(DestIP,0,@MacAddr,@PhyAddrLen);
      if ErrCode = S_OK then
       Result:=Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[MacAddr[0], MacAddr[1],MacAddr[2], MacAddr[3], MacAddr[4], MacAddr[5]])
    finally
      WSACleanup;
    end;
  end;

var
  gateway: string;
  ec: DWORD;
  macrouter: string;
  sl: TStringList;
  serr: string;
const
  DELIM = ',';
begin
  result := '';

  gateway := GetWMIarray('.', 'root\CIMV2', 'Win32_NetworkAdapterConfiguration', 'DefaultIPGateway', DELIM);
  gateway := StringReplace(gateway,'{','',[rfReplaceAll]);
  gateway := StringReplace(gateway,'}','',[rfReplaceAll]);

  sl := TStringList.Create;
  try
    sl.Delimiter := DELIM;
    sl.DelimitedText := gateway;
    if sl.Count = 0 then
    begin
      if debug then
        macrouter := 'ERR_NO_ADAPTERS'
      else
        macrouter := '';
    end
    else
    begin
      try
        macrouter := GetMacAddr(sl[0],ec);
      except
        on E: Exception do
        begin
          if debug then
            macrouter := 'ERR_EXCEPT_'+E.Message
          else
            macrouter := '';
        end;
      end;

      if ec = ERROR_BAD_NET_NAME then
        serr := 'ERROR_BAD_NET_NAME'
      else if ec = ERROR_BUFFER_OVERFLOW then
        serr := 'ERROR_BUFFER_OVERFLOW'
      else if ec = ERROR_GEN_FAILURE then
        serr := 'ERROR_GEN_FAILURE'
      else if ec = ERROR_INVALID_PARAMETER then
        serr := 'ERROR_INVALID_PARAMETER'
      else if ec = ERROR_INVALID_USER_BUFFER then
        serr := 'ERROR_INVALID_USER_BUFFER'
      else if ec = 1168(*ERROR_NOT_FOUND*) then
        serr := 'ERROR_NOT_FOUND'
      else if ec = ERROR_NOT_SUPPORTED then
        serr := 'ERROR_NOT_SUPPORTED'
      else if ec = ERROR_NETWORK_UNREACHABLE then // not documented in MSDN WinApi
        serr := 'ERROR_NETWORK_UNREACHABLE'
      else if ec <> S_OK then
        serr := 'ERROR_' + IntToStr(ec);

      if ec <> 0 then
      begin
        if debug then
          macrouter := serr
        else
          macrouter := '';
      end;
    end;
  finally
    FreeAndNil(sl);
  end;

  result := macrouter;
end;

procedure TForm6.Button1Click(Sender: TObject);
begin
  showmessage(GetRouterMac(true));
end;

initialization
  CoInitialize(nil);
finalization
  CoUnInitialize;
end.
Daniel Marschall
ViaThinkSoft Co-Founder