如何用delphi读取网卡物理号_Delphi

  • 内容
  • 评论
  • 相关

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

  Forms, Dialogs, StdCtrls,
  Nb, ExtCtrls;

http://www.gaodaima.com/65682.html如何用Delphi读取网卡物理号_Delphi

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Memo1: TMemo;
    Panel2: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{---------------------------------------------}
{ enumerate the lana's  - works only on WIN32 }
{---------------------------------------------}
function NbLanaEnum: TLana_Enum;
var
  NCB: TNCB;
  L_Enum: TLana_Enum;
  RetCode: Word;
begin
{$IFDEF WIN32}
  FillChar(NCB, SizeOf(NCB), 0);
  FillChar(L_Enum, SizeOf(TLana_Enum), 0);
  NCB.Command := NCB_ENUM;
  NCB.Buf := @L_Enum;
  NCB.Length := Sizeof(L_Enum);
  RetCode := NetBiosCmd(NCB);
  if RetCode <> NRC_GOODRET then begin
    L_Enum.Length := 0;
    L_Enum.Lana[0] := Byte(RetCode);
  end;
{$ELSE}                     { not supported for WIN16, fake LANA 0 }
  L_Enum.Length := 1;
  L_Enum.Lana[0] := 0;
{$ENDIF}
  Result := L_Enum;
end;

{----------------------------------------}
{ Reset the lana - don't for WIN16 !     }
{----------------------------------------}
function NbReset(l: Byte): Word;
var
  NCB: TNCB;
begin
{$IFNDEF WIN32}             { will reset all your connections for WIN1
6 }
  Result := NRC_GOODRET;    { so just fake a reset for Win16          
  }
{$ELSE}
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.Command := NCB_RESET;
  NCB.Lana_Num := l;
  Result := NetBiosCmd(NCB);
{$ENDIF}
end;
{----------------------------------------}
{ return the MAC address of an interface }
{ in the form of a string like :         }
{ 'xx:xx:xx:xx:xx:xx'                    }
{ using the definitions in nb.pas        }
{----------------------------------------}

function NbGetMacAddr(LanaNum: Integer): String;
var
  NCB: TNCB;
  AdpStat: TAdpStat;
  RetCode: Word;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  FillChar(AdpStat, SizeOf(AdpStat), 0);
  NCB.Command := NCB_ADPSTAT;
  NCB.Buf := @AdpStat;
  NCB.Length := Sizeof(AdpStat);
  FillChar(NCB.CallName, Sizeof(TNBName), $20);
  NCB.CallName[0] := Byte('*');
  NCB.Lana_Num := LanaNum;
  RetCode := NetBiosCmd(NCB);
  if RetCode = NRC_GOODRET then begin
    Result := Format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',
                   [AdpStat.ID[0],
                   AdpStat.ID[1],
                   AdpStat.ID[2],
                   AdpStat.ID[3],
                   AdpStat.ID[4],
                   AdpStat.ID[5]
                   ]);
  end else begin
    Result := '??:??:??:??:??:??';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  L_Enum : TLana_Enum;
  RetCode: Word;
  i: Integer;
begin
  L_Enum := NbLanaEnum;                       { enumerate lanas for WI
N NT }
  if L_Enum.Length = 0 then begin
    Button1.Caption := Format('LanaEnum err=%2.2x', [L_Enum.Lana[0]]);

    exit;
  end;

  for i := 0 to (L_Enum.Length - 1)do begin   { for every lana found  
     }

    RetCode := NbReset(L_Enum.Lana[i]);       { Reset lana for WIN NT
     }
    if RetCode <> NRC_GOODRET then begin
       Button1.Caption := Format('Reset Lana %d err=%2.2x',[i, RetCode
]);
       exit;
    end;
                                             { Get MAC Address        
     }
    Memo1.Lines.Add(Format('Lana %x = %s', [L_Enum.Lana[i], NbGetMacAd
dr(i)]));

  end;

  Button1.Caption := 'Stop';
end;

end.
——————————————————————————————————-

unit Nb;

{$F+}

{  nb.pas

   16/32 bit windows netbios access (follows IBM's Netbios 3.0 spec)

   (C) CEVI VZW - 29 april 1998     -- DH (Danny.Heijl@cevi.be) --

   You can (ab)use this code as you like, but please do not remove the
credits.

   I used reference material from IBM, Microsoft, Syntax and Byte when
I wrote
   the 16-bit (DOS) c-version ages ago (in Borland Turbo C 2.0 on a 38
6SX PC)
   with a Syntax SMB server running on Interactive Unix.
   I now converted this to 16 and 32 bit Delphi code.

}

interface

uses SysUtils, Winprocs, Wintypes;

const

{ size of a netbios name }
  NBNAMESIZE    = 16;

{ max number of network adapters }
{ remeber it's BIG Blue, right ? }
  MAXLANAS      = 254;

{ NCB Command codes }

  NCB_ASYNC     = $80;   { asynch command bit to be or-ed into command
}

  NCB_CALL      = $10;   { open a session }
  NCB_LISTEN    = $11;   { wait for a call }
  NCB_HANGUP    = $12;   { end session }
  NCB_SEND      = $14;   { send data }
  NCB_RECV      = $15;   { receive data }
  NCB_RECVANY   = $16;   { receive data on any session }
  NCB_CHAINSEND = $17;   { chain send data }
  NCB_DGSEND    = $20;   { send a datagram }
  NCB_DGRECV    = $21;   { receive datagram }
  NCB_DGSENDBC  = $22;   { send broadcast datagram }
  NCB_DGREVCBC  = $23;   { receive broadcast datagram }
  NCB_ADDNAME   = $30;   { add unique name to local table }
  NCB_DELNAME   = $31;   { delete name from local table }
  NCB_RESET     = $32;   { reset adapter }
  NCB_ADPSTAT   = $33;   { adapter status }
  NCB_SSTAT     = $34;   { session status }
  NCB_CANCEL    = $35;   { cancel NCB request }
  NCB_ADDGRPNAME= $36;   { add group name to local table }
  NCB_ENUM      = $37;   { enum adapters }
  NCB_UNLINK    = $70;   { unlink remote boot code }
  NCB_SENDNA    = $71;   { send, don't wait for ACK }
  NCB_CHAINSENDNA=$72;   { chain send, but don't wait for ACK }
  NCB_LANSTALERT= $73;   { lan status alert }
  NCB_ACTION    = $77;   { enable extensions }
  NCB_FINDNAME  = $78;   { search for name on the network }
  NCB_TRACE     = $79;   { activate / stop tracing }

{ NCB return codes }

  NRC_GOODRET     = $00;    { good return
                              also returned when ASYNCH request accept
ed }
  NRC_BUFLEN      = $01;    { illegal buffer length                   
   }
  NRC_ILLCMD      = $03;    { illegal command                         
   }
  NRC_CMDTMO      = $05;    { command timed out                       
   }
  NRC_INCOMP      = $06;    { message incomplete, issue another comman
d  }
  NRC_BADDR       = $07;    { illegal buffer address                  
   }
  NRC_SNUMOUT     = $08;    { session number out of range             
   }
  NRC_NORES       = $09;    { no resource available                   
   }
  NRC_SCLOSED     = $0a;    { session closed                          
   }
  NRC_CMDCAN      = $0b;    { command cancelled                       
   }
  NRC_DUPNAME     = $0d;    { duplicate name                          
   }
  NRC_NAMTFUL     = $0e;    { name table full                         
   }
  NRC_ACTSES      = $0f;    { no deletions, name has active sessions  
   }
  NRC_LOCTFUL     = $11;    { local session table full                
   }
  NRC_REMTFUL     = $12;    { remote session table full               
   }
  NRC_ILLNN       = $13;    { illegal name number                     
   }
  NRC_NOCALL      = $14;    { no callname                             
   }
  NRC_NOWILD      = $15;    { cannot put * in NCB_NAME                
   }
  NRC_INUSE       = $16;    { name in use on remote adapter           
   }
  NRC_NAMERR      = $17;    { name deleted                            
   }
  NRC_SABORT      = $18;    { session ended abnormally                
   }
  NRC_NAMCONF     = $19;    { name conflict detected                  
   }
  NRC_IFBUSY      = $21;    { interface busy, IRET before retrying    
   }
  NRC_TOOMANY     = $22;    { too many commands outstanding, retry lat
er }
  NRC_BRIDGE      = $23;    { ncb_lana_num field invalid              
   }
  NRC_CANOCCR     = $24;    { command completed while cancel occurring
   }
  NRC_CANCEL      = $26;    { command not valid to cancel             
   }
  NRC_DUPENV      = $30;    { name defined by anther local process    
   }
  NRC_ENVNOTDEF   = $34;    { environment undefined. RESET required   
   }
  NRC_OSRESNOTAV  = $35;    { required OS resources exhausted         
   }
  NRC_MAXAPPS     = $36;    { max number of applications exceeded     
   }
  NRC_NOSAPS      = $37;    { no saps available for netbios           
   }
  NRC_NORESOURCES = $38;    { requested resources are not available   
   }
  NRC_INVADDRESS  = $39;    { invalid ncb address or length > segment
   }
  NRC_INVDDID     = $3B;    { invalid NCB DDID                        
   }
  NRC_LOCKFAIL    = $3C;    { lock of user area failed                
   }
  NRC_OPENERR     = $3f;    { NETBIOS not loaded                      
   }
  NRC_SYSTEM      = $40;    { system error                            
   }

  NRC_PENDING     = $ff;    { asynchronous command is not yet finished
   }

{  Values for transport_id }

ALL_TRANSPORTS = 'M'#$00#$00#$00;
MS_NBF         = 'MNBF';

{  values for name_flags bits. }

NAME_FLAGS_MASK = $87;

GROUP_NAME      = $80;
UNIQUE_NAME     = $00;

REGISTERING     = $00;
REGISTERED      = $04;
DEREGISTERED    = $05;
DUPLICATE       = $06;
DUPLICATE_DEREG = $07;

{  Values for state }

  LISTEN_OUTSTANDING      = $01;
  CALL_PENDING            = $02;
  SESSION_ESTABLISHED     = $03;
  HANGUP_PENDING          = $04;
  HANGUP_COMPLETE         = $05;
  SESSION_ABORTED         = $06;

type

{ Netbios Name }
  TNBName = array[0..(NBNAMESIZE - 1)] of byte;

{ MAC address }
  TMacAddress = array[0..5] of byte;

  PNCB = ^TNCB;

{ Netbios Control Block }

{$IFDEF WIN32}
  TNCBPostProc = procedure(P: PNCB);
{$ENDIF}

  TNCB = packed record        { Netbios Control Block }
    Command:  byte;      { command code                       }
    RetCode:  byte;      { return code                        }
    LSN:      byte;      { local session number               }
    Num:      byte;      { name number                        }
    Buf:      ^byte;     { data buffer                        }
    Length:   word;      { data length                        }
    CallName: TNBName;   { name to call                       }
    Name:     TNBName;   { our own name                       }
    RTO:      byte;      { receive time-out                   }
    STO:      byte;      { send time-out                      }
  {$IFNDEF WIN32}
    Post_Offs:word;      { asynch notification routine offset }
    Post_Seg: word;      { asynch notification routine segment}
  {$ELSE}
    PostPrc:  TNCBPostProc;{ asynch notification routine (nb30) }
  {$ENDIF}
    Lana_Num: byte;     { adapter number                     }
    Cmd_Cplt: byte;     { command completion flag            }
  {$IFDEF WIN32}
    Reserved: array[0..9] of byte;  { Reserverd for Bios use }
    Event:    THandle;  { WIN32 event handle to be signalled }
                        { for asynch cmd completion          }
  {$ELSE}
    Reserved: array[0..13] of byte;  { Reserved }
  {$ENDIF}
  end;

{ Netbios Name Info record }
  PNameInfo = ^TNameInfo;
  TNameInfo = packed record  { name info record }
    Name:   TNBName;       { netbios name }
    NameNum:byte;          { name number  }
    NameSt: byte;          { name status  }
  end;

{ Netbios adapter status }
  PAdpStat = ^TAdpStat;
  TAdpStat = packed record    { adapter status record}
    ID:       TMacAddress;   { adapter mac address           }
    VMajor:   byte;          { software version major number }
    Resvd0:   byte;
    AdpType:  byte;          { adapter type                  }
    VMinor:   byte;          { software version minor number }
    RptTime:  word;          { reporting time period         }
    RcvCRC:   word;          { receive crc errors            }
    RcvOth:   word;          { receive other errors          }
    TxmCol:   word;          { transmit collisions           }
    TxmOth:   word;          { transmit other errors         }
    TxmOK:    LongInt;       { successfull transmissions     }
    RcvOK:    LongInt;       { successfull receives          }
    TxmRetr:  word;          { transmit retries              }
    NoRcvBuf: word;          { number of 'no receive buffer' }
    T1_tmo:   word;          { t1 time-outs                  }
    Ti_tmo:   word;          { ti time_outs                  }
    Resvd1:   LongInt;
    Free_Ncbs:word;          { number of free ncb's          }
    Cfg_Ncbs: word;          { number of configured ncb's    }
    max_Ncbs: word;          { max ncb's used                }
    NoTxmBuf: word;          { number of 'no transmit buffer'}
    MaxDGSize:word;          { max. datagram size            }
    Pend_Ses: word;          { number of pending sessions    }
    Cfg_Ses:  word;          { number of configured sessions }
    Max_Ses:  word;          { max sessions used             }
    Max_SPSz: word;          { max. session packet size      }
    nNames:   word;          { number of names in local table}
    Names:    array[0..15] of TnameInfo; { local name table  }
  end;

{
   Structure returned to the NCB command NCBSSTAT is SESSION_HEADER fo
llowed
   by an array of SESSION_BUFFER structures. If the NCB_NAME starts wi
th an
   asterisk then an array of these structures is returned containing t
he
   status for all names.
}

{ session header }
  PSession_Header = ^TSession_Header;
  TSession_Header = packed record
    sess_name:            byte;
    num_sess:             byte;
    rcv_dg_outstanding:   byte;
    rcv_any_outstanding:  byte;
  end;

{ session buffer }
  PSession_Buffer = ^TSession_Buffer;
  TSession_Buffer = packed record
    lsn:                  byte;
    state:                byte;
    local_name:           TNBName;
    remote_name:          TNBName;
    rcvs_outstanding:     byte;
    sends_outstanding:    byte;
  end;

{
   Structure returned to the NCB command NCBENUM.

   On a system containing lana's 0, 2 and 3, a structure with
   length =3, lana[0]=0, lana[1]=2 and lana[2]=3 will be returned.
}
  PLana_Enum = ^TLana_Enum;
  TLANA_ENUM = packed record
    length:   byte;         {  Number of valid entries in lana[] }
    lana:     array[0..(MAXLANAS - 1)] of byte;
  end;

{
   Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEAD
ER followed
   by an array of FIND_NAME_BUFFER structures.
}

  PFind_Name_Header = ^TFind_Name_Header;
  TFind_Name_Header = packed record
    node_count:    word;
    reserved:      byte;
    unique_group:  byte;
  end;

  PFind_Name_Buffer = ^TFind_Name_Buffer;
  TFind_Name_Buffer = packed record
    length:          byte;
    access_control:  byte;
    frame_control:   byte;
    destination_addr:TMacAddress;
    source_addr:     TMacAddress;
    routing_info:    array[0..17] of byte;
  end;

{
   Structure provided with NCBACTION. The purpose of NCBACTION is to p
rovide
   transport specific extensions to netbios.
}

  PAction_Header = ^TAction_Header;
  TAction_Header = packed record
    transport_id: LongInt;
    action_code:  Word;
    reserved:     Word;
  end;

{$IFDEF WIN32}
  function Netbios(P: PNCB): Char; stdcall;
{$ENDIF}

{ Exposed functions }

function NetbiosCmd(var NCB: TNCB): Word;

implementation

{$IFDEF WIN32}
function Netbios; external 'netapi32.dll' name 'Netbios';
{$ENDIF}

{---------------------------------}
{ execute a Windows Netbios Call  }
{---------------------------------}

function NetbiosCmd(var NCB: TNCB): Word;
begin
{$IFNDEF WIN32}
  asm
    push bp                   { save bp }
    push ss                   { save ss }
    push ds                   { save ds }
    les  bx, NCB              { get segment/offset address of NCB }
    call NetBiosCall;         { 16 bit Windows Netbios call }
    xor  ah,ah
    mov  @Result, ax          { store return code }
    pop  ds                   { restore ds }
    pop  ss                   { restore ss }
    pop  bp                   { restore bp }
  end;
{$ELSE}
  Result := Word(Netbios(PNCB(@NCB))); { 32 bit Windows Netbios call }

{$ENDIF}
end;

欢迎大家阅读《如何用delphi读取网卡物理号_Delphi》,跪求各位点评,若觉得好的话请收藏本文,by 搞代码

原创文章,转载请注明: 转载自搞代码

本文链接地址: 如何用delphi读取网卡物理号_Delphi

微信支付二维码

微信 赏一包辣条吧~

支付宝支付二维码

支付宝 赏一听可乐吧~

评论

0条评论

发表评论

电子邮件地址不会被公开。 必填项已用*标注