unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
windows, nb30, strutils;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
function GetAdapterInfo(Lana: UCHAR): string;
var
Adapter: TAdapterStatus;
NCB: TNCB;
begin
NCB := default(TNCB); // FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := NCBRESET;
NCB.ncb_lana_num := Lana;
if Netbios(@NCB) <> NRC_GOODRET then
begin
Result := 'Address not known';
Exit;
end;
NCB := default(TNCB); // FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := NCBASTAT;
NCB.ncb_lana_num := Lana;
NCB.ncb_callname[0] := Byte('*'); // NCB.ncb_callname := Asc('*');
Adapter := default(TAdapterStatus); // FillChar(Adapter, SizeOf(Adapter), 0);
NCB.ncb_buffer := @Adapter;
NCB.ncb_length := SizeOf(Adapter);
if Netbios(@NCB) <> NRC_GOODRET then
begin
Result := 'Address not known';
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;
AdapterIndex: UCHAR;
Info: string;
begin
NCB := default(TNCB); // FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := NCBENUM;
NCB.ncb_buffer := @AdapterList;
NCB.ncb_length := SizeOf(AdapterList);
if Netbios(@NCB) = NRC_GOODRET then
begin
if AdapterList.length > 0 then // if Byte(AdapterList.length) > 0
begin
Result := '';
for AdapterIndex := 0 to AdapterList.length-1 do
begin
WriteStr
(
Info,
'Adapter[', AdapterIndex, '].MacAddress = ',
GetAdapterInfo(AdapterList.lana[AdapterIndex]),
IfThen(AdapterIndex < AdapterList.length-1, ', ', '')
);
Result := Result + Info;
end;
end
else Result := 'No adapters found';
end
else
Result := 'Unable to obtain adapterlist';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetMACAddress);
end;
End.