MAC Address

[mmab]

Hi I've found a code for Delphi.
http://www.daniweb.com/code/snippet216710.html

but it requires NB30 , which I couldn't find it. Is it a part of Delphi? Or is it already implemented in Lazarus?

Thanks

[mmab]

I guess I've found a solution to obtain Mac address using Tprocess.
Simply run tprocess and call ipconfig /all command under windows and ifconfig under linux, and then parse what you get from pipe.

[Silvio Clécio]

See:

http://code.google.com/p/lazsolutions/source/browse/trunk/Core/LSUtils.pas#252

[mmab]

many thanks.

[enemy]

hi,

this http://code.google.com/p/lazsolutions/source/browse/trunk/Core/LSUtils.pas#252

on windows xp is ok

windows 7 not work

any help?

[gerson.rodrigues]

Try to use the code below. It works in Win7 and MacOS. I did not run in Linux and WinXP

unit util;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, Dialogs, Process, StrUtils;

type

TUTil = class
  public
    class function GetMacAddress : string;
end;

function GetIfTable( pIfTable : Pointer;
                 VAR pdwSize  : LongInt;
                     bOrder   : LongInt ): LongInt; stdcall;

implementation

function GetIfTable( pIfTable : Pointer;
                 VAR pdwSize  : LongInt;
                     bOrder   : LongInt ): LongInt; stdcall; external 'IPHLPAPI.DLL';

class function TUtil.GetMacAddress : string;

function GetLinuxMacAddress : string;
const
  linux_path     = '/sys/class/net/%s/address';
  default_device = 'eth0';

var
  f       : textfile;
  device,
  path,
  addr    : string;

begin
  Result := '';
  device := default_device;

  path := Format(linux_path,[device]);
  if (not FileExists(path)) then
  begin
     Result := '';
  end
  else
  begin
    AssignFile(f, path);
    reset(f);
    readln(f, addr);
    closefile(f);
    Result := addr;
  end;
end;

function GetMacOSXMacAddress : string;
var
  theProcess: TProcess;
  theOutput: TStringList;
  i, j, theLine, thePos: integer;

begin
  theProcess := TProcess.Create(nil);
  theProcess.Executable := 'ifconfig';
  theProcess.Parameters.Add('en0');
  theProcess.Options := theProcess.Options + [poWaitOnExit, poUsePipes];
  theProcess.Execute;
  theOutput := TStringList.Create;
  theOutput.LoadFromStream(theProcess.Output);

  theLine := -1;
  for i := 0 to theOutput.Count - 1 do
  begin
    j := pos('ether', theOutput.Strings);
    if (j > 0) then
    begin
      theLine := i;
      thePos := j + length('ether') + 1;
    end;
  end;
  if (theLine > -1) then
    Result := UpperCase(ExtractSubStr(theOutput.Strings[theLine], thePos, [' ']));

  theOutput.Free;
  theProcess.Free;
end;

function GetWinMacAddress: String;
const
  MAX_INTERFACE_NAME_LEN             = $100;
  ERROR_SUCCESS                      = 0;
  MAXLEN_IFDESCR                     = $100;
  MAXLEN_PHYSADDR                    = 8;

  MIB_IF_TYPE_ETHERNET               = 6;

  _MAX_ROWS_ = 20;

type

   MIB_IFROW            = Record
     wszName : Array[0 .. (MAX_INTERFACE_NAME_LEN * 2 - 1)] of char;
     dwIndex              : LongInt;
     dwType               : LongInt;
     dwMtu                : LongInt;
     dwSpeed              : LongInt;
     dwPhysAddrLen        : LongInt;
     bPhysAddr : Array[0 .. (MAXLEN_PHYSADDR-1)] of Byte;
     dwAdminStatus        : LongInt;
     dwOperStatus         : LongInt;
     dwLastChange         : LongInt;
     dwInOctets           : LongInt;
     dwInUcastPkts        : LongInt;
     dwInNUcastPkts       : LongInt;
     dwInDiscards         : LongInt;
     dwInErrors           : LongInt;
     dwInUnknownProtos    : LongInt;
     dwOutOctets          : LongInt;
     dwOutUcastPkts       : LongInt;
     dwOutNUcastPkts      : LongInt;
     dwOutDiscards        : LongInt;
     dwOutErrors          : LongInt;
     dwOutQLen            : LongInt;
     dwDescrLen           : LongInt;
     bDescr     : Array[0 .. (MAXLEN_IFDESCR - 1)] of Char;
     end;

   _IfTable = Record
                 nRows : LongInt;
                 ifRow : Array[1.._MAX_ROWS_] of MIB_IFROW;
              end;

var
   pIfTable  : ^_IfTable;
   TableSize : LongInt;
   tmp       : String;
   i,j       : Integer;
   ErrCode   : LongInt;
begin
   pIfTable := nil;
   //------------------------------------------------------------
   Result := '';
   try
      //-------------------------------------------------------
      // First: just get the buffer size.
      // TableSize returns the size needed.
      TableSize := 0; // Set to zero so the GetIfTabel function
                    // won't try to fill the buffer yet,
                    // but only return the actual size it needs.
      GetIfTable(pIfTable, TableSize, 1);
      if (TableSize < SizeOf(MIB_IFROW) + Sizeof(LongInt)) then
      begin
         Exit; // less than 1 table entry?!
      end; // if-end.

      // Second:
      // allocate memory for the buffer and retrieve the
      // entire table.
      GetMem(pIfTable, TableSize);
      ErrCode := GetIfTable(pIfTable, TableSize, 1);
      if (ErrCode <> ERROR_SUCCESS) then
      begin
         Exit; // OK, that did not work.
               // Not enough memory i guess.
      end; // if-end.

      // Read the ETHERNET addresses.
      for i := 1 to pIfTable^.nRows do
      try
         if (pIfTable^.ifRow.dwType=MIB_IF_TYPE_ETHERNET) and
             (pIfTable^.ifRow.dwOutOctets <> 0) then
         begin
            tmp := '';
            for j:=0 to pIfTable^.ifRow.dwPhysAddrLen-1 do
            begin
               tmp := tmp + format('%.2x:',
                      [ pIfTable^.ifRow.bPhysAddr[j] ] );
            end; // for-end.
            //-------------------------------------
            if Length(tmp)>0 then
            begin
              Result := Copy(tmp, 1, Length(tmp) - 1);
              Exit;
            end;
         end; // if-end.
      except
         Exit;
      end; // if-try-except-end.
   finally
      if Assigned(pIfTable) then FreeMem(pIfTable, TableSize);
   end; // if-try-finally-end.
end;


begin
  Result := '';
  {$IFDEF LINUX}
  Result := GetLinuxMacAddress;
  {$ENDIF}
  {$IFDEF DARWIN}
  Result := GetMacOSXMacAddress;
  {$ENDIF}
  {$IFDEF WINDOWS}
  Result := GetWinMacAddress;
  {$ENDIF}
end;


end.



You can use TUtil.GetMacAddress without a constructor because it is a class function.

Example:

implementation

uses Util;

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageDlg(TUtil.GetMacAddress(), mtinformation, [mbok], 0);
end;

end.

[howardpc]

Thanks for this.
Somehow the array indexing for the ifRow variable has dropped out of the above code.
Occurrences of ifRow. need to be replaced by ifRow[ i ]. before it compiles successfully.

[gerson.rodrigues]

I get the first occurence of a MAC ADDRESS active.

The key is the line below:

"if (pIfTable^.ifRow.dwType=MIB_IF_TYPE_ETHERNET) and
             (pIfTable^.ifRow.dwOutOctets <> 0) then ..."

"OUTOCTECS <> 0" informs the Net Card sent bytes, in other words, is alive.

Another point: I forgot to put some declarations as OS dependent. Follow the last version (tested on MACOSX and Win7):

unit util;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, Dialogs, Process, StrUtils;

type

TUTil = class
  public
    class function GetMacAddress : string;
end;
{$IFDEF WINDOWS}
function GetIfTable( pIfTable : Pointer;
                 VAR pdwSize  : LongInt;
                     bOrder   : LongInt ): LongInt; stdcall;
{$ENDIF}

implementation
{$IFDEF WINDOWS}
function GetIfTable( pIfTable : Pointer;
                 VAR pdwSize  : LongInt;
                     bOrder   : LongInt ): LongInt; stdcall; external 'IPHLPAPI.DLL';
{$ENDIF}

class function TUtil.GetMacAddress : string;

{$IFDEF LINUX}
function GetLinuxMacAddress : string;
const
  linux_path     = '/sys/class/net/%s/address';
  default_device = 'eth0';

var
  f       : textfile;
  device,
  path,
  addr    : string;

begin
  Result := '';
  device := default_device;

  path := Format(linux_path,[device]);
  if (not FileExists(path)) then
  begin
     Result := '';
  end
  else
  begin
    AssignFile(f, path);
    reset(f);
    readln(f, addr);
    closefile(f);
    Result := addr;
  end;
end;
{$ENDIF}

{$IFDEF DARWIN}
function GetMacOSXMacAddress : string;
var
  theProcess: TProcess;
  theOutput: TStringList;
  i, j, theLine, thePos: integer;

begin
  theProcess := TProcess.Create(nil);
  theProcess.Executable := 'ifconfig';
  theProcess.Parameters.Add('en0');
  theProcess.Options := theProcess.Options + [poWaitOnExit, poUsePipes];
  theProcess.Execute;
  theOutput := TStringList.Create;
  theOutput.LoadFromStream(theProcess.Output);

  theLine := -1;
  for i := 0 to theOutput.Count - 1 do
  begin
    j := pos('ether', theOutput.Strings );
    if (j > 0) then
    begin
      theLine := i;
      thePos := j + length('ether') + 1;
    end;
  end;
  if (theLine > -1) then
    Result := UpperCase(ExtractSubStr(theOutput.Strings[theLine], thePos, [' ']));

  theOutput.Free;
  theProcess.Free;
end;
{$ENDIF}

{$IFDEF WINDOWS}
function GetWinMacAddress: String;
const
  MAX_INTERFACE_NAME_LEN             = $100;
  ERROR_SUCCESS                      = 0;
  MAXLEN_IFDESCR                     = $100;
  MAXLEN_PHYSADDR                    = 8;

  MIB_IF_TYPE_ETHERNET               = 6;

  _MAX_ROWS_ = 20;

type

   MIB_IFROW            = Record
     wszName : Array[0 .. (MAX_INTERFACE_NAME_LEN * 2 - 1)] of char;
     dwIndex              : LongInt;
     dwType               : LongInt;
     dwMtu                : LongInt;
     dwSpeed              : LongInt;
     dwPhysAddrLen        : LongInt;
     bPhysAddr : Array[0 .. (MAXLEN_PHYSADDR-1)] of Byte;
     dwAdminStatus        : LongInt;
     dwOperStatus         : LongInt;
     dwLastChange         : LongInt;
     dwInOctets           : LongInt;
     dwInUcastPkts        : LongInt;
     dwInNUcastPkts       : LongInt;
     dwInDiscards         : LongInt;
     dwInErrors           : LongInt;
     dwInUnknownProtos    : LongInt;
     dwOutOctets          : LongInt;
     dwOutUcastPkts       : LongInt;
     dwOutNUcastPkts      : LongInt;
     dwOutDiscards        : LongInt;
     dwOutErrors          : LongInt;
     dwOutQLen            : LongInt;
     dwDescrLen           : LongInt;
     bDescr     : Array[0 .. (MAXLEN_IFDESCR - 1)] of Char;
     end;

   _IfTable = Record
                 nRows : LongInt;
                 ifRow : Array[1.._MAX_ROWS_] of MIB_IFROW;
              end;

var
   pIfTable  : ^_IfTable;
   TableSize : LongInt;
   tmp       : String;
   i,j       : Integer;
   ErrCode   : LongInt;
begin
   pIfTable := nil;
   //------------------------------------------------------------
   Result := '';
   try
      //-------------------------------------------------------
      // First: just get the buffer size.
      // TableSize returns the size needed.
      TableSize := 0; // Set to zero so the GetIfTabel function
                    // won't try to fill the buffer yet,
                    // but only return the actual size it needs.
      GetIfTable(pIfTable, TableSize, 1);
      if (TableSize < SizeOf(MIB_IFROW) + Sizeof(LongInt)) then
      begin
         Exit; // less than 1 table entry?!
      end; // if-end.

      // Second:
      // allocate memory for the buffer and retrieve the
      // entire table.
      GetMem(pIfTable, TableSize);
      ErrCode := GetIfTable(pIfTable, TableSize, 1);
      if (ErrCode <> ERROR_SUCCESS) then
      begin
         Exit; // OK, that did not work.
               // Not enough memory i guess.
      end; // if-end.

      // Read the ETHERNET addresses.
      for i := 1 to pIfTable^.nRows do
      try
         if (pIfTable^.ifRow.dwType=MIB_IF_TYPE_ETHERNET) and
             (pIfTable^.ifRow.dwOutOctets <> 0) then
         begin
            tmp := '';
            for j:=0 to pIfTable^.ifRow.dwPhysAddrLen-1 do
            begin
               tmp := tmp + format('%.2x:',
                      [ pIfTable^.ifRow.bPhysAddr[j] ] );
            end; // for-end.
            //-------------------------------------
            if Length(tmp)>0 then
            begin
              Result := Copy(tmp, 1, Length(tmp) - 1);
              Exit;
            end;
         end; // if-end.
      except
         Exit;
      end; // if-try-except-end.
   finally
      if Assigned(pIfTable) then FreeMem(pIfTable, TableSize);
   end; // if-try-finally-end.
end;
{$ENDIF}


begin
  Result := '';
  {$IFDEF LINUX}
  Result := GetLinuxMacAddress;
  {$ENDIF}
  {$IFDEF DARWIN}
  Result := GetMacOSXMacAddress;
  {$ENDIF}
  {$IFDEF WINDOWS}
  Result := GetWinMacAddress;
  {$ENDIF}
end;


end.

[gerson.rodrigues]

Project using the class util.

[Jurassic Pork]

hello,
maybe  you  can use   runcommand (using ipconfig with windows and ifconfig with linux, MacOsX) and regexpr to parse the results.

example to extract mac and ip address  on linux :

Code: [Select]

uses  Regexpr,Process, ....
....
var reponse : string;
    re: TRegExpr;
    i: integer;
begin
RunCommand('/sbin/ifconfig',['eth0'],reponse);
try
  re := TRegExpr.Create;
  re.Expression := 'HWaddr ([^ ]+).*inet adr:([^ ]+)';
  re.Exec(reponse);
  for i:=1 to re.SubExprMatchCount do
    writeln(re.Match[i]);
finally
  re.Free;
end;       
end;
ps : runcommand available since fpc 2.6.4  ( see fpc\2.6.4\source\packages\fcl-process\src\process.pp)

[marcov]

Runcommand is 2.6.2 iirc, with minor enhancements after.

Unit nb30 is also available now. Looking at the dates, I translated it because of this (original) discussion. (committed 2010-09-25)

[gerson.rodrigues]

Thanks, Jurassic Pork.

I 've used this idea for GetMacOSXMacAddress function (but using TProcess rather than RunCommand).

[chrnobel]

In Linux it can be done very simple:

Code: [Select]

var
  AProcess:TProcess;
  AStringList:TStringList;

begin
  AProcess := TProcess.Create(nil);
  AStringList := TStringList.Create;
  AProcess.CommandLine := 'cat /sys/class/net/eth0/address';
  AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
  AProcess.Execute;
  AStringList.LoadFromStream(AProcess.Output);
  writeln(AStringList.CommaText);
  Aprocess.Destroy;
end.

[aducom]

I know this is an old post, but to keep all the info together...

The above sample of obtaining a mac address only works for fixed ethernet lines, not wireless. I changed the code a bit so it will also provide the wireless mac if available:

Code: [Select]

// Read the ETHERNET addresses.
      for i := 1 to pIfTable^.nRows do
      try
         if (pIfTable^.ifRow.dwType=MIB_IF_TYPE_ETHERNET) and
             (pIfTable^.ifRow.dwOutOctets <> 0) then
         begin

to be changed to

Code: [Select]

      // Read the ETHERNET addresses.
      for i := 1 to pIfTable^.nRows do
      try
         if (pIfTable^.ifRow[i].dwType in [MIB_IF_TYPE_ETHERNET, IF_TYPE_IEEE80211]) and
             (pIfTable^.ifRow[i].dwOutOctets <> 0) then
         begin
 
It needs the next declaration:

Code: [Select]

function GetWinMacAddress: String;
const
  MAX_INTERFACE_NAME_LEN             = $100;
  ERROR_SUCCESS                      = 0;
  MAXLEN_IFDESCR                     = $100;
  MAXLEN_PHYSADDR                    = 8;

  MIB_IF_TYPE_ETHERNET               = 6;
  IF_TYPE_IEEE80211                  = 71;           


[jamie]

Uses Windows,.......
Types...
Var....

Function NetBios(aNCB:PNCB):Byte; StdCall external 'netapi32.dll' name 'Netbios';

That seems to load in both the 32 and 64 bit Laz...

 Maybe the Delphi example will now work for Windows?