Các chiêu thức trong lập trình Quét tất cả các máy trong mạng LAN

Quét tất cả các máy trong mạng LAN home
Giới thiệu : Với đọan Code sau chương trình của bạn sẽ quét tên tất cả các máy tính rong cùng mạng
LAN với máy tính của bạn (Khi chương trình chạy)
Xuất xứ : www.pscode.com
Binh khí sử dụng :
- 1 Class mang tên LAN
- 1 ListBox (Trong Form bạn cần hiển thị) với tên : LstLAN
Đoạn mã :
‘Trong Class :
Option Explicit
Dim PCLIST As String 'buffer to hold pc's names
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias _
"WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias _
"WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, _
ByVal lpBuffer As Long, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" _
(ByVal hEnum As Long) As Long
Private Const RESOURCE_CONNECTED = &H1
Private Const RESOURCE_GLOBALNET = &H2

Private Const RESOURCE_REMEMBERED = &H3
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_UNKNOWN = &HFFFF
Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Const RESOURCEUSAGE_CONTAINER = &H2
Private Const RESOURCEUSAGE_RESERVED = &H80000000
Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
Private Declare Function GlobalAlloc Lib "kernel32" _
(ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
ByVal cbCopy As Long)

Private Declare Function CopyPointer2String Lib _
"kernel32" Alias "lstrcpyA" (ByVal NewString As _
String, ByVal OldString As Long) As Long
Private Function DoNetEnum()
Dim hEnum As Long, lpBuff As Long, NR As NETRESOURCE
Dim cbBuff As Long, cCount As Long
Dim P As Long, res As Long, i As Long
On Error Resume Next
If Err.Number > 0 Then Exit Function
On Error GoTo ErrorHandler
NR.lpRemoteName = 0

cbBuff = 1024 * 31
cCount = &HFFFFFFFF
res = WNetOpenEnum(RESOURCE_GLOBALNET, _
RESOURCETYPE_ANY, 0, NR, hEnum)
If res = 0 Then
lpBuff = GlobalAlloc(GPTR, cbBuff)
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
P = lpBuff
For i = 1 To cCount
CopyMemory NR, ByVal P, LenB(NR)
'list.AddItem PointerToString(NR.lpRemoteName)
DoNetEnum2 NR
P = P + LenB(NR)
Next i
End If
ErrorHandler:
On Error Resume Next
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum)
End If
End Function
Private Function PointerToString(P As Long) As String
Dim s As String
s = String(65535, Chr$(0))
CopyPointer2String s, P
PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function
Private Sub DoNetEnum2(NR As NETRESOURCE)
Dim hEnum As Long, lpBuff As Long

Dim cbBuff As Long, cCount As Long
Dim P As Long, res As Long, i As Long
cbBuff = 1024 * 31
cCount = &HFFFFFFFF
res = WNetOpenEnum(RESOURCE_GLOBALNET, _
RESOURCETYPE_ANY, 0, NR, hEnum)
If res = 0 Then
lpBuff = GlobalAlloc(GPTR, cbBuff)
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
P = lpBuff
For i = 1 To cCount
CopyMemory NR, ByVal P, LenB(NR)
Dim st As String
Select Case NR.dwDisplayType
Case &H1
st = "Domain"
Case &H2
st = "Server"
Case &H3
st = "Share"
Case &H4
st = "File"
Case &H5
st = "Groups"
Case &H6
st = "Protocol Categories"
End Select
If LCase(st) <> "domain" Then
PCLIST = PCLIST & "||" &

Replace(PointerToString(NR.lpRemoteName), "\", "") '& " is a : " & st
End If
DoEvents
If Not NR.dwDisplayType = 2 Then DoNetEnum2 NR
P = P + LenB(NR)
Next i
End If
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum)
End If
PCLIST = stripDelimiter(PCLIST)
End Sub
Property Get GetPCList() As String
GetPCList = PCLIST
End Property
Private Function stripDelimiter(ByVal s As String) As String
If Left(s, 2) = "||" Then s = Right(s, Len(s) - 2)
stripDelimiter = s
End Function
Private Sub Class_Initialize()
DoNetEnum
End Sub
‘Trong Form :
Private Sub Form_Load()
Dim LANScan As New LAN
Dim s() As String
Dim i
s = Split(LANScan.GetPCList, "||")
For i = LBound(s) To UBound(s)
LstLAN.AddItem s(i)

Next
End Sub