其他

开发平台：
Delphi

NetBEUI.pas：源码内容
							unit NetBEUI;
//{$define NCB_CHECK}
interface
uses SysUtils,windows,winsock,nb30,classes,dialogs;
type
TNetBEUI=class(TComponent)
    protected
    pNetBiosInfo:PNameBuffer;
    FMacAddr:string;
    FLocalName,FRemoteName:String;
    FAdapterType:BYTE;
    FNameList:TList;
    procedure NBCheck(ncb:TNCB);
    procedure MakeNetbiosName(var Dest:array of char;Src:string);
    function  NBReset(nLana,nSessions,nNames:integer):Boolean;
    function  NBListNames(nLana:Integer;strHostName:string):Boolean;
    function  NBAdapterStatus(nLana:Integer;pBuf:PChar;bufLen:Integer;strHostName:String):Boolean;
    procedure GetHostNames(strRemoteIp:String);
    function  GetErrorMsg(rc:char):string;
    public
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
    function  GetNetBiosStatus(IpAddr:String):Boolean;
    function GetMACAddr:string;
    function  GetNetBiosNameList:TList;
    function  GetRemoteHostName:string;
    function  GetAdapterType:BYTE;
    class function GetLocalMAC:String;
    end;
const
LANANUM=0;
DIALUP=$FF;
ETHERNET=$FE;
implementation
{ TNetBEUI }
constructor TNetBEUI.Create(AOwner:TComponent);
begin
Inherited;
FNameList:=TList.Create;
end;
destructor TNetBEUI.Destroy;
var
i:Integer;
begin
for i:=0 to FNameList.Count-1 do
    begin
    FreeMem(FNameList.Items[i]);
    end;
Inherited;
end;
function TNetBEUI.GetAdapterType: BYTE;
begin
Result:=FAdapterType;
end;
function TNetBEUI.GetErrorMsg(rc: char): string;
begin
case rc of
      Chr($00) : Result := 'good return' ;
      Chr($01) : Result := 'illegal buffer length' ;
      Chr($03) : Result := 'illegal command' ;
      Chr($05) : Result := 'command timed out' ;
      Chr($06) : Result := 'message incomplete, issue another command' ;
      Chr($07) : Result := 'illegal buffer address' ;
      Chr($08) : Result := 'session number out of range' ;
      Chr($09) : Result := 'no resource available' ;
      Chr($0a) : Result := 'session closed' ;
      Chr($0b) : Result := 'command cancelled' ;
      Chr($0d) : Result := 'duplicate name' ;
      Chr($0e) : Result := 'name table full' ;
      Chr($0f) : Result := 'no deletions, name has active sessions' ;
      Chr($11) : Result := 'local session table full' ;
      Chr($12) : Result := 'remote session table full' ;
      Chr($13) : Result := 'illegal name number' ;
      Chr($14) : Result := 'no callname' ;
      Chr($15) : Result := 'cannot put * in NCB_NAME' ;
      Chr($16) : Result := 'name in use on remote adapter' ;
      Chr($17) : Result := 'name deleted' ;
      Chr($18) : Result := 'session ended abnormally' ;
      Chr($19) : Result := 'name conflict detected' ;
      Chr($21) : Result := 'interface busy, IRET before retrying' ;
      Chr($22) : Result := 'too many commands outstanding, retry later' ;
      Chr($23) : Result := 'NCB_lana_num field invalid' ;
      Chr($24) : Result := 'command completed while cancel occurring' ;
      Chr($26) : Result := 'command not valid to cancel' ;
      Chr($30) : Result := 'name defined by anther local process' ;
      Chr($34) : Result := 'environment undefined. RESET required' ;
      Chr($35) : Result := 'required OS resources exhausted' ;
      Chr($36) : Result := 'max number of applications exceeded' ;
      Chr($37) : Result := 'no saps available for netbios' ;
      Chr($38) : Result := 'requested resources are not available' ;
      Chr($39) : Result := 'invalid ncb address or length > segment' ;
      Chr($3B) : Result := 'invalid NCB DDID' ;
      Chr($3C) : Result := 'lock of user area failed' ;
      Chr($3f) : Result := 'NETBIOS not loaded' ;
      Chr($40) : Result := 'system error' ;
      Chr($ff) : Result := 'asynchronous command is not yet finished' ;
      else Result := 'unknown'
    end ;
end;
procedure TNetBEUI.GetHostNames(strRemoteIp: String);
var
ent:PHostEnt;
addr:DWORD;
begin
addr:=inet_addr(PChar(strRemoteIp));
ent:=gethostbyaddr(@addr,4,AF_INET);
if(ent<>nil)then FRemoteName:=ent.h_name
else FRemoteName:='无法获得';
//FreeMem(ent);
end;
function HexBL(vv: Byte): String;
begin
//  result:=D2H(vv , 2)+' '//十进制转十六进制;
Result:=Format('%X',[vv]);
end;
class function TNetBEUI.GetLocalMAC: String;
var
NCB : TNCB ; // Netbios control block //NetBios控制块
ADAPTER : TADAPTERSTATUS ; // Netbios adapter status//取网卡状态
LANAENUM : TLANAENUM ; // Netbios lana
intIdx : Integer ; // Temporary work value//临时变量
cRC : Char ; // Netbios return code//NetBios返回值
strTemp : String ; // Temporary string//临时变量
begin
// Initialize
Result := '' ;
try
    // Zero control blocl
    ZeroMemory(@NCB,SizeOf(NCB)) ;
    // Issue enum command
    NCB.ncb_command := Chr(NCBENUM) ;
    //cRC := NetBios(@NCB) ;//Modify by Gale
    NetBios(@NCB);
    // Reissue enum command
    NCB.ncb_buffer := @LANAENUM ;
    NCB.ncb_length := SizeOf(LANAENUM) ;
    cRC := NetBios(@NCB) ;
    if Ord(cRC)<>0 then
        exit ;
    // Reset adapter
    ZeroMemory(@NCB,SizeOf(NCB)) ;
    NCB.ncb_command := Chr(NCBRESET) ;
    NCB.ncb_lana_num := LANAENUM.lana[0] ;
    cRC := NetBios(@NCB) ;
    if Ord(cRC)<>0 then
        exit ;
    // Get adapter address
    ZeroMemory(@NCB,SizeOf(NCB)) ;
    NCB.ncb_command := Chr(NCBASTAT) ;
    NCB.ncb_lana_num := LANAENUM.lana[0] ;
    StrPCopy(NCB.ncb_callname,'*') ;
    NCB.ncb_buffer := @ADAPTER ;
    NCB.ncb_length := SizeOf(ADAPTER) ;
    //cRC := NetBios(@NCB) ;//Modify by Gale remove Hint:'cRC' never used
    NetBios(@NCB);
    // Convert it to string
    strTemp := HexBL(Byte(ADAPTER.Adapter_Address[0]));
    for intIdx := 1 to 5 do
        strTemp := strTemp+':'+HexBL(Byte(ADAPTER.adapter_address[intIdx]));
    Result := strTemp ;
finally
    end ;
end;
function TNetBEUI.GetMACAddr: string;
begin
Result:=FMacAddr;
end;
function TNetBEUI.GetNetBiosNameList:TList;
begin
Result:=FNameList;
end;
function TNetBEUI.GetNetBiosStatus(IpAddr: String): Boolean;
begin
if (NBReset (LANANUM, 10, 10))then
    begin
    if (NBListNames (LANANUM,IpAddr))then
        begin
        Result:=True;
        end
    else Result:=False;
    end
else result:=False;
end;
function TNetBEUI.GetRemoteHostName: string;
begin
Result:=FRemoteName;
end;
procedure TNetBEUI.MakeNetbiosName(var Dest:array of char; Src: string);
var
l,i:Integer;
begin
l:=Length(Src);//cchSrc = lstrlen (szSrc);
if(l>NCBNAMSZ)then l:=NCBNAMSZ;   //if (cchSrc > NCBNAMSZ) cchSrc = NCBNAMSZ;
//for i:=0 to NCBNAMSZ-l do Dest[i]:=chr($20);
FillMemory(@Dest,NCBNAMSZ,$20);
for i:=1 to l do Dest[i-1]:=Src[i];
end;
function TNetBEUI.NBAdapterStatus(nLana: Integer; pBuf: PChar;
  bufLen: Integer; strHostName: String): Boolean;
var
ncb:TNCB;
begin
ZeroMemory(@ncb,sizeof(ncb));
ncb.ncb_command := chr(NCBASTAT);
ncb.ncb_lana_num := chr(nLana);
ncb.ncb_buffer :=pBuf;
ncb.ncb_length := bufLen;
ncb.ncb_rto:=chr(10);
ncb.ncb_sto:=chr(2);
MakeNetbiosName (ncb.ncb_callname, strHostName);
Netbios (@ncb);
NBCheck (ncb);
Result:=(chr(NRC_GOODRET) = ncb.ncb_retcode);
end;
procedure TNetBEUI.NBCheck(ncb: TNCB);
begin
{$ifdef NCB_CHECK}
if(ncb.ncb_retcode<>chr(NRC_GOODRET))then
    ShowMessage(GetErrorMsg(ncb.ncb_retcode));
{$endif}
end;
function TNetBEUI.NBListNames(nLana: Integer;
  strHostName: string): Boolean;
var
i,bufLen:Integer;
pStatus:PAdapterStatus;
pNames:PNameBuffer;
begin
GetHostNames(PChar(strHostName));
    // Allocate the largest buffer that might be needed.
bufLen:= sizeof (TAdapterStatus) + 255 * sizeof (TNameBuffer);
pStatus:= AllocMem(bufLen);  //(ADAPTER_STATUS *) HeapAlloc (hHeap, 0, cbBuffer);
if(pStatus=nil)then
    begin
    Result:=False;
    Exit;
    end;
if (not NBAdapterStatus (nLana,Pointer(pStatus),bufLen, strHostName))then
    begin
    FreeMem(pStatus);
    Result:=False;
    Exit;
    end;
// The list of names follows the adapter status structure.
pNames :=PNameBuffer(
    PChar(pStatus)
    +sizeof(TAdapterStatus)
    );
{FMacAddr:=format('%02x_%02x_%02x_%02x_%02x_%02x',
            [Ord(pStatus.adapter_address[0]),
            Ord(pStatus.adapter_address[1]),
            Ord(pStatus.adapter_address[2]),
            Ord(pStatus.adapter_address[3]),
            Ord(pStatus.adapter_address[4]),
            Ord(pStatus.adapter_address[5])]);}
FMacAddr:=
    IntToHex(Ord(pStatus.adapter_address[0]),2)+'-'+
    IntToHex(Ord(pStatus.adapter_address[1]),2)+'-'+
    IntToHex(Ord(pStatus.adapter_address[2]),2)+'-'+
    IntToHex(Ord(pStatus.adapter_address[3]),2)+'-'+
    IntToHex(Ord(pStatus.adapter_address[4]),2)+'-'+
    IntToHex(Ord(pStatus.adapter_address[5]),2);
FAdapterType:=BYTE(pStatus.adapter_type);
for i:= 0 to pStatus.name_count-1 do
    begin
    pNetBiosInfo:=AllocMem(sizeof(TNameBuffer));
//    pNetBiosInfo^:=(pNames)[i];
    pNetBiosInfo^:=PNameBuffer(PChar(pNames)+sizeof(TNameBuffer)*i)^;
    FNameList.Add(pNetBiosInfo);
    end;
    
FreeMem(pStatus);
Result:=True;
end;
function TNetBEUI.NBReset(nLana, nSessions, nNames: integer): Boolean;
var
ncb:TNCB;
begin
{
    NCB ncb;
    memset (&ncb, 0, sizeof (ncb));
    ncb.ncb_command = NCBRESET;
    ncb.ncb_lsn = 0;                // Allocate new lana_num resources
    ncb.ncb_lana_num = nLana;
    ncb.ncb_callname[0] = nSessions;  // maximum sessions
    ncb.ncb_callname[2] = nNames;   // maximum names
    Netbios (&ncb);
    NBCheck (ncb);
    return (NRC_GOODRET == ncb.ncb_retcode);
}
ZeroMemory(@ncb,sizeof(ncb));
ncb.ncb_command := chr(NCBRESET);
ncb.ncb_lsn := chr(0);                // Allocate new lana_num resources
ncb.ncb_lana_num := chr(nLana);
ncb.ncb_callname[0] := chr(nSessions);  // maximum sessions
ncb.ncb_callname[2] := chr(nNames);   // maximum names
Netbios (@ncb);
//NBCheck (ncb);
//Result:=(chr(NRC_GOODRET) = ncb.ncb_retcode);
Result:=true;
end;
end.

						