體驗.NET Multithreading的快感 --- 以VB.NET開發Thread Pool式網路芳鄰掃瞄程式 (VB.NET)
體驗.NET Multithreading的快感 --- 以VB.NET開發Thread Pool式網路芳鄰掃瞄程式
Imports System.Diagnostics
Imports System.IO
Imports System.Text
Imports System.Threading
Module Module1
Sub Main()
Dim I As Integer
Dim lStart As Long, lEnd As Long
Dim iCount As Integer = 0
Dim sResult As String
Dim NBS(254) As CNetBIOSScanner
Dim callBack As WaitCallback
lStart = Environment.TickCount
'將計數值設為0
CNetBIOSScanner.iJobTotal = 0
CNetBIOSScanner.iJobDone = 0
For I = 1 To 254
'建立新物件
NBS(I) = New CNetBIOSScanner()
callBack = New WaitCallback(AddressOf NBS(I).Detect)
'指向事件函數
AddHandler NBS(I).Done, AddressOf NBS_onDone
'以IP位址作為參數
ThreadPool.QueueUserWorkItem(callBack, "192.168.0." & I)
Next I
'每隔0.5秒檢查一次是否所有的物件均已完成?
While (CNetBIOSScanner.iJobDone < CNetBIOSScanner.iJobTotal)
Thread.Sleep(500)
End While
'統計結果
For I = 1 To 254
sResult = NBS(I).Result
If InStr(sResult, "ERROR") = 0 Then iCount = iCount + 1
Next
lEnd = Environment.TickCount
Console.WriteLine("共計花費" & (lEnd - lStart) & "ms...")
Console.WriteLine("找到" & iCount & "台Windows主機")
Console.ReadLine()
End Sub
Sub NBS_onDone(ByVal Result As String)
Console.WriteLine(Result)
End Sub
Class CNetBIOSScanner
'宣告為Shared後, 即使有再多個CNetBIOSScanner物件, 都共用一份變數
Public Shared iJobTotal As Integer
Public Shared iJobDone As Integer
Public Result As String
'使用Event完成非同步呼叫
Public Event Done(ByVal Result As String)
Public Sub New()
Interlocked.Increment(iJobTotal)
End Sub
Private Sub SetJobDone(ByVal sResult As String)
Result = sResult
'為了即時反應, 呼叫Done Event將結果立刻顯示出來
'涉及多Thread共用資料, 加上SyncLock保護
SyncLock GetType(CNetBIOSScanner)
RaiseEvent Done(sResult)
'工作結束, iJobDone計數加一, 但此時多Thread並行, 需使用保護機制
iJobDone = iJobDone + 1
End SyncLock
End Sub
Public Sub Detect(ByVal state As Object)
'檢查使用者傳入的是否為合法IPAddress, 藉用System.Net.IPAddress
Dim IP As String = CType(state, String)
Try
Dim ipValid As System.Net.IPAddress
ipValid = System.Net.IPAddress.Parse(IP)
Catch '使用者傳入的非合法的IP位址格式
SetJobDone("ERROR: Invalid IP Address")
Exit Sub
End Try
'Ping測試, 當IP不存在時, ping的傳回結果會出現timed out字眼, 以此判別IP存在與否
If InStr(Shell("ping.exe", "-n 1 " & IP), "timed out") > 0 Then
SetJobDone("ERROR: IP doesn't exists!")
Exit Sub
Else 'IP存在, 進行nbtstat -A解析
Dim sTemp As String
sTemp = Shell("nbtstat.exe", "-A " & IP)
'傳回結果若不包含任何UNIQUE字樣表示未查到相關的NetBIOS名稱資料
If InStr(sTemp, "UNIQUE") = 0 Then
SetJobDone("ERROR: Host not found.")
Exit Sub
Else
'將傳回結果解析成為多行
Dim sLines() As String
sLines = Split(sTemp, vbCrLf)
Dim sUsername As String = "", sMachineName As String = ""
Dim I As Integer, sNetBIOSName As String
For I = 0 To UBound(sLines)
'以<00> UNIQUE識別機器名稱, 排除IS~開頭者
If InStr(sLines(I), "<00> UNIQUE") > 0 Then
sNetBIOSName = Trim(Left(sLines(I), InStr(sLines(I), "<00>") - 1))
If Left(sNetBIOSName, 3) <> "IS~" Then
sMachineName = sNetBIOSName
End If
ElseIf InStr(sLines(I), "<03> UNIQUE") > 0 Then '由<03> UNIQUE識別使用者名稱
sUsername = Trim(Left(sLines(I), InStr(sLines(I), "<03>") - 1))
End If
Next
SetJobDone(IP & "," & sMachineName & "," & sUsername)
Exit Sub
End If
End If
End Sub
Private Function Shell(ByVal sExeFile As String, ByVal sArgument As String) As String
Dim pShell As Process
pShell = New Process()
'設定執行檔及參數
pShell.StartInfo.FileName = sExeFile
pShell.StartInfo.Arguments = sArgument
'必須要設定以下兩個屬性才可將輸出結果導向
pShell.StartInfo.UseShellExecute = False
pShell.StartInfo.RedirectStandardOutput = True
'不顯示任何視窗
pShell.StartInfo.CreateNoWindow = True
'開始執行
pShell.Start()
'將StdOUT的結果轉為字串, 其中StandardOutput屬性類別為StreamReader
Shell = pShell.StandardOutput.ReadToEnd()
pShell.WaitForExit()
End Function
End Class
End Module
如有錯誤 歡迎指正