Tuesday, December 09, 2008

Get MAC Address in Delphi

There are many ways to detect your computer MAC Address. But these function below represent some of them :
Via NetBIOS #1

If you need to detect your machine's MAC address programmatically, you may want to use the following code. This code always looks at the first networking adapter - some machines may have more than one.

This compiles fine under Delphi 5. Not tested in newer Delphi versions.

Alternatively you could shell execute the command line tool ipconfig with parameter /all and capture its output which will contain the MAC address as well.



program GetMAC;  uses   Dialogs, SysUtils, nb30;  function GetMACAddress(PCName: string) : string; type   TASTAT = packed record     adapt: nb30.TADAPTERSTATUS;     NameBuff: array [0..30] of TNAMEBUFFER;   end;   var   NCB: TNCB;   Tmp: String;   pASTAT: Pointer;   AST: TASTAT; begin   // The IBM NetBIOS 3.0 specifications defines four basic   // NetBIOS environments under the NCBRESET command. Win32   // follows the OS/2 Dynamic Link Routine (DLR) environment.   // This means that the first NCB issued by an application   // must be a NCBRESET, with the exception of NCBENUM.   // The Windows NT implementation differs from the IBM   // NetBIOS 3.0 specifications in the NCB_CALLNAME field.   FillChar(NCB, SizeOf(NCB), 0);   NCB.ncb_command := Chr(NCBRESET);   NetBios(@NCB);    // To get the Media Access Control (MAC) address for an   // ethernet adapter programmatically, use the Netbios()   // NCBASTAT command and provide a "*" as the name in the   // NCB.ncb_CallName field (in a 16-chr string).   // NCB.ncb_callname = "* "   FillChar(NCB, SizeOf(NCB), 0);   FillChar(NCB.ncb_callname[0], 16, ' ');   Move(PCName[1], NCB.ncb_callname[0], Length(PCName));   NCB.ncb_command := Chr(NCBASTAT);    // For machines with multiple network adapters you need to   // enumerate the LANA numbers and perform the NCBASTAT   // command on each. Even when you have a single network   // adapter, it is a good idea to enumerate valid LANA numbers   // first and perform the NCBASTAT on one of the valid LANA   // numbers. It is considered bad programming to hardcode the   // LANA number to 0 (see the comments section below).   NCB.ncb_lana_num := #0;   NCB.ncb_length := SizeOf(AST);    GetMem(pASTAT, NCB.ncb_length);    if pASTAT=nil then   begin     result := 'memory allocation failed!';     exit;   end;   NCB.ncb_buffer := pASTAT;   NetBios(@NCB);    Move(NCB.ncb_buffer, AST, SizeOf(AST));    with AST.adapt do     Tmp := Format('%.2x-%.2x-%.2x-%.2x-%.2x-%.2x',              [ord(adapter_address[0]), ord(adapter_address[1]), ord(adapter_address[2]),               ord(adapter_address[3]), ord(adapter_address[4]), ord(adapter_address[5])]);    FreeMem(pASTAT);   Result := Tmp; end;  begin   ShowMessage(GetMACAddress('*')); end.


I have tried your method (using NB30) before but it does not always work.
Here is a way that always works:


unit ethernet_address;

interface

uses classes, sysutils;

const
MAX_INTERFACE_NAME_LEN = $100;
ERROR_SUCCESS = 0;
MAXLEN_IFDESCR = $100;
MAXLEN_PHYSADDR = 8;

MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0 ;
MIB_IF_OPER_STATUS_UNREACHABLE = 1;
MIB_IF_OPER_STATUS_DISCONNECTED = 2;
MIB_IF_OPER_STATUS_CONNECTING = 3;
MIB_IF_OPER_STATUS_CONNECTED = 4;
MIB_IF_OPER_STATUS_OPERATIONAL = 5;

MIB_IF_TYPE_OTHER = 1;
MIB_IF_TYPE_ETHERNET = 6;
MIB_IF_TYPE_TOKENRING = 9;
MIB_IF_TYPE_FDDI = 15;
MIB_IF_TYPE_PPP = 23;
MIB_IF_TYPE_LOOPBACK = 24;
MIB_IF_TYPE_SLIP = 28;

MIB_IF_ADMIN_STATUS_UP = 1;
MIB_IF_ADMIN_STATUS_DOWN = 2;
MIB_IF_ADMIN_STATUS_TESTING = 3;


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;

function Get_EthernetAddresses: TStringList;

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


implementation

Function GetIfTable; stdcall; external 'IPHLPAPI.DLL';

function Get_EthernetAddresses: TStringList;
const
_MAX_ROWS_ = 20;

type
_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:=TStringList.Create;
if Assigned(Result) then
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[i].dwType=MIB_IF_TYPE_ETHERNET then
begin
tmp:='';
for j:=0 to pIfTable^.ifRow[i].dwPhysAddrLen-1 do
begin
tmp := tmp + format('%.2x',
[ pIfTable^.ifRow[i].bPhysAddr[j] ] );
end; // for-end.
//-------------------------------------
if Length(tmp)>0 then Result.Add(tmp);
end; // if-end.
except
Exit;
end; // if-try-except-end.
finally
if Assigned(pIfTable) then FreeMem(pIfTable,TableSize);
end; // if-try-finally-end.
end;

end.
// Enjoy!

via NetBIOS #2

uses NB30;

function GetAdapterInfo(Lana: Char): String;
var
Adapter: TAdapterStatus;
NCB: TNCB;
begin
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBRESET);
NCB.ncb_lana_num := Lana;
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
Exit;
end;

FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBASTAT);
NCB.ncb_lana_num := Lana;
NCB.ncb_callname := '*';

FillChar(Adapter, SizeOf(Adapter), 0);
NCB.ncb_buffer := @Adapter;
NCB.ncb_length := SizeOf(Adapter);
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
Exit;
end;
Result :=
IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;

function GetMACAddress: string;
var
AdapterList: TLanaEnum;
NCB: TNCB;
begin
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBENUM);
NCB.ncb_buffer := @AdapterList;
NCB.ncb_length := SizeOf(AdapterList);
Netbios(@NCB);
if Byte(AdapterList.length) > 0 then
Result := GetAdapterInfo(AdapterList.lana[0])
else
Result := 'mac not found';
end;

// usage
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetMACAddress);
end;

via windows API (Ole32.dll)

The code below gets your MAC address. Should you have more than one NIC in your machine you will get the MAC off the first one.

function CoCreateGuid(var guid: TGUID): HResult; stdcall; far external 'ole32.dll';  function Get_MACAddress: string; var   g: TGUID;   i: Byte; begin   Result := '';   CoCreateGUID(g);   for i := 2 to 7 do     Result := Result + IntToHex(g.D4[i], 2); end; 


Yahoo! Toolbar kini dilengkapi Anti-Virus dan Anti-Adware gratis. Download Yahoo! Toolbar sekarang .

0 Comments: