ViaThinkSoft CodeLib
Dieser Artikel befindet sich in der Kategorie:
CodeLib → Programmierhilfen → Delphi
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 Mitbegründer
ViaThinkSoft Mitbegründer