中国DOS联盟

NbtstatPacket = toByte("000000000001" &_
		"00000000000020434b" &_
		"4141414141414141" &_
		"4141414141414141" &_
		"4141414141414141" &_
		"4141414141410000210001")

DIM WSTATE,ip,HOST,MAC,NSTATE
Set Winsock = Wscript.CreateObject("MSWinsock.Winsock","sck_")
Winsock.Protocol = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO.OpenTextFile(fso.GetBaseName(WScript.ScriptName) & ".txt", 2,True)
BeginTimer = Timer()

objFile.WriteLine "IPAddress" & vbTab & "Host" & vbTab & "MAC"
objFile.WriteLine String(39,"-")

For i = 1 To 254
	NSTATE = True
	HOST = "":MAC = ""
	ip = "192.168.1." & i
	CALL Nbtstat(ip)
	If NSTATE Then
		objFile.WriteLine ip & vbTab & HOST & vbTab & MAC
	End If
Next

EndTimer = Timer()
TimeSpan_Send = EndTimer - BeginTimer
TimeSpan=CStr(Round(TimeSpan_Send, 4))

objFile.WriteLine String(39,"-")
objFile.WriteLine "用时：" & TimeSpan & " 秒"
Wscript.echo "用时：" & TimeSpan & " 秒"

Function Nbtstat(ip)
	Winsock.RemoteHost = ip
	Winsock.RemotePort = 137
	Winsock.SendData NbtstatPacket
	Dim WAIT
	WSTATE = False
	While WAIT < 2 AND Not WSTATE
  		Wscript.Sleep 15
		WAIT = WAIT + 1
	Wend
	If WAIT=2 Then
		NSTATE = False
		'objFile.WriteLine Winsock.state & " - 超时退出！"
	End If
End Function

Sub sck_DataArrival(ByVal bytesTotal)
	On Error Resume Next
	Winsock.GetData RevData
	If Err.Number = 0 Then
		toHex RevData
	Else
		'NSTATE = False
		HOST = "Host not found."
	End If
	Err.Clear
	WSTATE = True
	Winsock.Close
End Sub

Function toByte(data)
	set xml_dom = CreateObject("Microsoft.XMLDOM")
	set l_node = xml_dom.createElement("byte")
	l_node.dataType = "bin.hex"
	l_node.Text = data
	toByte = l_node.nodeTypedvalue
End Function

Function toHex(data)
	set xml_dom = CreateObject("Microsoft.XMLDOM")
	set l_node = xml_dom.createElement("byte")
	l_node.dataType = "bin.hex"
	l_node.nodeTypedvalue = data
	StrHex = l_node.Text
	B = Eval("&H" & Mid(StrHex,56*2+1,1*2))
	HOST = Trim(Hex2Ascii(Mid(StrHex,57*2+1,15*2)))
	[u]MAC  = UCase(Mid(StrHex,57*2+1+(B*18*2),6*2))[/u]
End Function

Function Hex2Ascii(strHex)
	dim i
	for i = 1 To Len(strHex) Step 2
		Hex2Ascii = Hex2Ascii & Chr(Eval("&H" & Mid(strHex, i, 2)))
	Next
End Function