umacfunction.~pas

定时扫描局域网络中的电脑的Mac地址情况

unit UMacFunction;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, winsock;
Type
  ipaddr = longint;
  pulong = ^u_long;

  function SendARP(DestIP: ipaddr; SrcIP: ipaddr; pMacAddr: pulong; PhyAddrLen:pulong): DWORD; stdcall; external 'IPHLPAPI.DLL'
  procedure doGetMacByIp(const ipaddress: WideString;var macaddress, status: OleVariant);
  function  GetMacByIp(const ipaddress: String):string;

  function GetMacAddress(const AServerName : string) : string;
  
implementation

function  GetMacByIp(const ipaddress: String):string;
var  status, macaddr: olevariant;
begin
   dogetmacbyip(ipaddress, macaddr, status);
   result:=macaddr;
end;

procedure doGetMacByIp(const ipaddress: WideString; var macaddress,
  status: OleVariant);
var
  destip: integer;
  pmacaddr: pulong;
  addrlen: u_long;
  macaddr: array[1..6] of byte;
  p: pbyte;
  s: string;
  i: integer;
  ipstr: string;

begin
  IPstr := IPaddress;

  DestIP := inet_addr(pchar(IPstr));  //目标机器的IP地址
  pMacAddr := pulong(@MacAddr);
  AddrLen := sizeof(MacAddr);
  if SendARP(DestIP, 0, pMacAddr, @AddrLen) = 0 then
  begin
    s := '';
    p := pbyte(pMacAddr);
    if ((p <> nil) and (AddrLen > 0)) then
    begin
      for i := 1 to AddrLen do
      begin
        s := s + IntToHex(p^, 2) + '-';
        p := Pointer(Integer(p) + SizeOf(Byte));
      end;
      SetLength(s, Length(s) - 1);
    end;
  end;
  macaddress := s;
end;


// ====================================================================== 
//返回值是主机AServerName的MAC地址
//AServerName参数的格式为'\\ServerName' 或者 'ServerName' 
//参数ServerName为空时返回本机的MAC地址 
//MAC地址以'XX-XX-XX-XX-XX-XX'的格式返回
// ====================================================================== 

function GetMacAddress(const AServerName : string) : string;
type
     TNetTransportEnum = function(pszServer : PWideChar;
                                  Level : DWORD;
                                  var pbBuffer : pointer;
                                  PrefMaxLen : LongInt;
                                  var EntriesRead : DWORD;
                                  var TotalEntries : DWORD;
                                  var ResumeHandle : DWORD) : DWORD; stdcall;

     TNetApiBufferFree = function(Buffer : pointer) : DWORD; stdcall;

     PTransportInfo = ^TTransportInfo;
     TTransportInfo = record
                       quality_of_service : DWORD;
                       number_of_vcs : DWORD;
                       transport_name : PWChar;
                       transport_address : PWChar;
                       wan_ish : boolean; 
                     end; 

var E,ResumeHandle, 
    EntriesRead, 
    TotalEntries : DWORD; 
    FLibHandle : THandle; 
    sMachineName, 
    sMacAddr, 
    Retvar : string; 
    pBuffer : pointer; 
    pInfo : PTransportInfo; 
    FNetTransportEnum : TNetTransportEnum; 
    FNetApiBufferFree : TNetApiBufferFree; 
    pszServer : array[0..128] of WideChar; 
    i,ii,iIdx : integer; 
begin 
  sMachineName := trim(AServerName); 
  Retvar := '00-00-00-00-00-00'; 

  // Add leading \\ if missing 
  if (sMachineName <> '') and (length(sMachineName) >= 2) then begin 
    if copy(sMachineName,1,2) <> '\\' then
      sMachineName := '\\' + sMachineName 
  end; 

  // Setup and load from DLL 
  pBuffer := nil; 
  ResumeHandle := 0; 
  FLibHandle := LoadLibrary('NETAPI32.DLL'); 

  // Execute the external function 
  if FLibHandle <> 0 then begin 
    @FNetTransportEnum := GetProcAddress(FLibHandle,'NetWkstaTransportEnum'); 
    @FNetApiBufferFree := GetProcAddress(FLibHandle,'NetApiBufferFree'); 
    E := FNetTransportEnum(StringToWideChar(sMachineName,pszServer,129),0, 
                           pBuffer,-1,EntriesRead,TotalEntries,Resumehandle); 

    if E = 0 then begin 
      pInfo := pBuffer; 

      // Enumerate all protocols - look for TCPIP 
      for i := 1 to EntriesRead do begin 
        if pos('TCPIP',UpperCase(pInfo^.transport_name)) <> 0 then begin 
          // Got It - now format result 'xx-xx-xx-xx-xx-xx' 
          iIdx := 1;
          sMacAddr := pInfo^.transport_address; 

          for ii := 1 to 12 do begin 
            Retvar[iIdx] := sMacAddr[ii]; 
            inc(iIdx); 
            if iIdx in [3,6,9,12,15] then inc(iIdx); 
          end; 
        end; 

        inc(pInfo); 
      end; 
      if pBuffer <> nil then FNetApiBufferFree(pBuffer); 
    end; 

    try 
      FreeLibrary(FLibHandle); 
    except 
      // 错误处理
    end;
  end;
  result:=Retvar;
end;

end.