【delphi开源代码栏目提醒】:网学会员delphi开源代码为您提供Frm_GetMac.pas参考,解决您在Frm_GetMac.pas学习中工作中的难题,参考学习。
unit Frm_GetMac;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,nb30, StdCtrls, XPMan;
type
TFrmGetMac = class(TForm)
BtnGetMac: TButton;
GroupBox1: TGroupBox;
LblMac: TLabel;
BtnClose: TButton;
XPManifest1: TXPManifest;
procedure BtnGetMacClick(Sender: TObject);
procedure BtnCloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmGetMac: TFrmGetMac;
implementation
{$R *.dfm}
function GetNetBIOSAddress : string;
var ncb : TNCB;
status : TAdapterStatus;
lanenum : TLanaEnum;
procedure ResetAdapter (num : char);
begin
fillchar(ncb,sizeof(ncb),0);
ncb.ncb_command:=char(NCBRESET);
ncb.ncb_lana_num:=num;
Netbios(@ncb);
end;
var
i:integer;
lanNum : char;
address : record
part1 : Longint;
part2 : Word;
end absolute status;
begin
Result:='';
fillchar(ncb,sizeof(ncb),0);
ncb.ncb_command:=char(NCBENUM);
ncb.ncb_buffer:=@lanenum;
ncb.ncb_length:=sizeof(lanenum);
Netbios(@ncb);
if lanenum.length=#0 then exit;
lanNum:=lanenum.lana[0];
ResetAdapter(lanNum);
fillchar(ncb,sizeof(ncb),0);
ncb.ncb_command:=char(NCBASTAT);
ncb.ncb_lana_num:=lanNum;
ncb.ncb_callname[0]:='*';
ncb.ncb_buffer:=@status;
ncb.ncb_length:=sizeof(status);
Netbios(@ncb);
ResetAdapter(lanNum);
for i:=0 to 5 do
begin
result:=result+inttoHex(integer(Status.adapter_address[i]),2);
if (i<5) then
result:=result+'-';
end;
end;
procedure TFrmGetMac.BtnGetMacClick(Sender: TObject);
begin
LblMac.Caption:=GetNetBIOSAddress;
end;
procedure TFrmGetMac.BtnCloseClick(Sender: TObject);
begin
Close;
end;
end.