www.pudn.com > oicqspysrc.zip > 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.