แจกฟรีโค้ดโปรแกรมอ่านค่า IP Address เป็น DNS (LAN และ Internet) - VB6

Option Explicit

' นับจำนวน IP Address ที่ตรวจพบ
Dim CountIP As Long

' เก็บค่า IP ชุดสุดท้ายของค่าเริ่มต้นเอาไว้ เช่น 192.168.0.1 จะเก็บค่า 1
Dim IPStartScan As Integer
' เก็บค่า IP ชุดสุดท้ายของค่าสิ้นสุดเอาไว้  เช่น 192.168.0.254 จะเก็บค่า 254
Dim IPEndScan As Integer

' เก็บค่า IP 3 ชุดแรก เช่น 192.168.0.254 จะเก็บค่า 192.168.0 เอาไว้
Dim strIP As String

' ตัวแปรเก็บค่าสถานะของการ Scan หา IP
' หากเป็นจริง สถานะกำลัง Scan
' หากเป็นเท็จ สถานะหยุดการ Scan
Dim blnScan As Boolean

Private Const AF_INET = 2

' #####################################################
' TIPS : กรณีที่เราประกาศ WIN32 API ในฟอร์ม จะใช้การประกาศแบบ Private
' หากนำไปใช้ใน Module ต้องเปลี่ยนการประกาศเป็น Public แทนน่ะครับ
' #####################################################

' ฟังค์ชั่นที่แปลงหมายเลข IPv4 ให้กลายเป็นเลขจำนวนเต็มแบบไม่คิดเครื่องหมายแทน (มีแต่ 0 กับ เลขบวก) เช่น
' จาก 192.168.1.20 ก็จะกลายเป็น 335653056 แทน แต่ใช้งานจริงมันจะต้องประมวลผลในเลขฐาน 2 น่ะครับ
Private Declare Function inet_addr Lib "wsock32.dll" ( _
    ByVal addr As String) _
    As Long

' http://msdn.microsoft.com/en-us/library/ms738521%28VS.85%29.aspx
' ฟังค์ชั่นที่ใช้ในการค้นหาข้อมูลเกี่ยวกับ Host ที่ทำการทดสอบ
' หากไม่พบ Error ฟังค์ชั่นนี้จะชี้ไปที่โครงสร้างของ HOSTENT
' แต่หากพบ Error ก็จะส่งค่า NULL Pointer กลับมา และ ระบุรหัสความผิดพลาดต่อไปที่ WSAGetLastError
Private Declare Function gethostbyaddr Lib "wsock32.dll" ( _
    addr As Long, _
    ByVal addr_len As Long, _
    ByVal addr_type As Long _
    ) _
    As Long

' http://msdn.microsoft.com/en-us/library/ms738552%28v=VS.85%29.aspx
' การกำหนดชนิดของข้อมูลแบบโครงสร้าง หรือ เป็นชุดเอาไว้ (Structure)
' เป็นการเก็บข้อมูลรายละเอียดของ Remote Host ที่เรากำลังทำการทดสอบ
' การเรียกใช้งานต้องประกาศตัวแปรแบบโครงสร้างขึ้นมาก่อน เช่น
' Dim Host As HOSTENT
' การเรียกใช้ คือ Host.hName ก็คือการอ่านชื่อ Host Name
Private Type HOSTENT
    hName           As Long
    hAliases        As Long
    hAddrType       As Integer
    hLen            As Integer
    hAddrList       As Long
End Type

' http://msdn.microsoft.com/en-us/library/ms741580%28v=VS.85%29.aspx
' แจ้งความผิดพลาดตามรหัสที่ส่งมาจากฟังค์ชี่น gethostbydddr
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long

' การชี้ตำแหน่งของ Memory Address
' ด้วยการคัดลอกข้อมูลจากตำแหน่งเริ่มต้น (Source) ไปเก็บไว้ที่ตำแหน่งปลายทาง (Destination)
' แล้วนับความยาว (Length) ตามจำนวนไบต์
' นี่คือ การใช้งาน Pointer ของภาษา Basic
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As Long _
    )

' ###################################################

' ###################################################
' โปรแกรมย่อยทำการอ่านค่า DNS โดยการรับค่า IP Address เข้ามาตรวจสอบ
' และทำการส่งค่า DNS แบบ String กลับคืนไป
Public Function IPtoDNS(ByVal sRemoteIP As String) As String
' ###################################################
    
    On Error GoTo ErrorHandler
    
    ' ประกาศให้ตัวแปร Host เรียกใช้ไปยังโครงสร้าง HOSTENT
    Dim Host As HOSTENT
    
    Dim dwRemoteIP As Long
    
    ' ทดสอบหาการชี้ตำแหน่ง Memory Address ของ Remote IP
    Dim lngTemp As Long
    
    ' เก็บชื่อของ HostName เอาไว้
    Dim strHostName As String
    
    ' เปลี่ยนค่า IP เป็นค่าตัวเลขแบบ Long ก่อน ด้วยฟังค์ชั่น inet_addr ให้สังเกตด้วยว่าเจ้าตัวนี้มันเป็น API
    dwRemoteIP = inet_addr(sRemoteIP)
    
    ' ให้ Pointer ชี้ไปยังโครงสร้างของ HOSTENT
    ' ซึ่งจะเก็บข้อมูลที่เกี่ยวกับที่เกี่ยวข้องกับ Network
    lngTemp = gethostbyaddr(dwRemoteIP, 4, AF_INET)
    
    ' หากค้นหาตำแหน่งที่เก็บข้อมูลของ Network Address ได้ (ในโครงสร้าง HOSTENT)
    If lngTemp <> 0 Then
        
        ' ชี้ตำแหน่ง Memory Address ที่เก็บข้อมูลของ Network ตามโครงสร้าง HOSTENT
        ' โดยที่มันจะชี้จุดเริ่มต้นตำแหน่งปลายทาง, จุดเริ่มต้นตำแหน่งต้นทาง และ ความยาวข้อมูลที่ต้องการ
        ' ขอให้สังเกตด้วยว่าเป็นการชี้ไปที่ Memory Address ของปลายทาง (Host) (ที่ๆเราจะคัดลอกข้อมูลไปเก็บ)
        ' แต่เอาค่า (ByVal) ของ lngTemp ไปเก็บที่ Memory Address ของ Host ตามขนาด Len(Host)
        CopyMemory Host, ByVal lngTemp, Len(Host)
        ' นั่นก็คือ เอาข้อมูลของเครื่องปลายทาง ไปเก็บไว้ในหน่วยความจำที่ใดที่หนึ่งก่อน
        
        ' จองพื้นที่ในการเก็บค่า Host Name จำนวน 256 ตัวอักขระ โดยใส่ค่า ASCII Code CHR(0) เอาไว้ก่อน
        ' ค่านี้ก็คือ NULL นั่นเอง ที่ต้องทำอย่างนี้ เพราะเราไม่รู้ค่าความยาวที่แน่นอนของ Host Name
        ' ดังนั้นเมื่อได้ค่ามายาวเท่าไรก็ตาม ก็จะตัดค่าที่เป็น NULL ทิ้งออกไปตั้งแต่ที่พบตัวแรกเลย ตามคำสั่ง
        ' Left(strHostName, InStr(strHostName, Chr(0)) - 1)
        ' หรือ อาจจะเรียกได้ว่าเป็นเทคนิคของการตัดคำที่เราไม่รู้ค่าความยาวที่แน่นอนครับ
        ' การจะใช้ค่าอื่น ที่ไม่ใช่ CHR(0) อาจจะทำให้เกิดข้อผิดพลาดได้
        strHostName = String(256, 0)
        
        ' อ่านค่า Host Name จาก Memory Address โดยเอาเฉพาะ hName มาเท่านั้น
        ' เป็นการเรียกผ่านตัวแปรโครงสร้าง Host น่ะครับ ... สังเกตให้ดีด้วย
        ' เอาค่า (ByVal) จาก Memory Address ของต้นทาง Host.hName
        ' ไปไว้ในตัวแปร strHostName (ตัวแปรตัวนี้มันจะมี Memory Address อะไรก็ช่างหัวมัน)
        CopyMemory ByVal strHostName, ByVal Host.hName, 256
        ' นำข้อมูลของเครื่องปลายทางที่เคยเก็บเอาไว้ ก็ให้นำออกมาแสดงผล

        ' เรื่องของ Pointer ใน VB6 ... ก็ค่อยๆไล่แกะไปน่ะครับผม สู้ๆ
        
        ' หากไม่พบข้อมูลของ Network Address จะส่งรหัสความผิดพลาดไปที่ WSAGetLastError()
        ' เพื่อที่จะได้แจ้งกลับมาว่าเกิดข้อผิดพลาดประการใดขึ้นมา
        If strHostName = "" Then
            
            IPtoDNS = "DNS Error : " & Str$(WSAGetLastError())
        
        ' พบข้อมูลของ Network Address
        Else
            ' ให้อ่านค่า DNS จากซ้ายไปขวา จนกว่าจะเจอรหัส ASCII Code CHR(0) หรือ ค่า NULL
            ' เมื่อพบแล้วให้ลบออก 1 ไม่งั้น CHR(0) มันจะติดเข้ามาด้วยครับ
            IPtoDNS = Left(strHostName, InStr(strHostName, Chr(0)) - 1)
                    
        End If
    
    ' หากระบุ DNS ไม่ได้ ส่วนใหญ่จะเป็นพวกอุปกรณ์สื่อสาร เช่น Modem, Router
    ' ค่า lngTemp จะมีค่าเป็น 0
    Else
        IPtoDNS = "ไม่สามารถระบุ DNS ได้"
    End If
    
ExitProc:
    Exit Function
    
ErrorHandler:
    
    ' ขณะโปรแกรมกำลังทำงาน (Run Time) ดัก Error จาก On Error GoTo ErrorHandler
    If Err.Number <> 0 Then MsgBox "Error " & Err.Number & vbCrLf & Err.Description
    Resume ExitProc
    
End Function

' ###################################################
' ส่วนที่เหลือเป็นเรื่องของการ Scan หา IP Address ตามหมายเลข Port ที่กำหนด
' หากยังไม่เข้าใจ ก็ควรจะไปศึกษาข้อมูลตามลิ้งค์ด้านบนก่อนด้วยน่ะครับ
' ###################################################

' กรณีสั่งหยุดการ Scan ชั่วคราว
Private Sub cmdStop_Click()
    ' กำหนด False เพื่อหยุดการ Scan Port
    blnScan = False
End Sub

Private Sub Form_Load()
    ' ตั้งฟอร์มอยู่กึ่งกลาง
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    
    ' ปิด Timer เอาไว้ก่อน เพราะยังไม่ได้สั่งให้มันทำงาน
    Timer1.Enabled = False
    
    ' ตัวอย่างน่ะครับ
    txtStartIP(0).Text = "192"
    txtStartIP(1).Text = "168"
    txtStartIP(2).Text = "0"
    txtStartIP(3).Text = "0"
    
    txtEndIP(0).Text = "192"
    txtEndIP(1).Text = "168"
    txtEndIP(2).Text = "0"
    txtEndIP(3).Text = "255"
    
    txtPort.Text = "80"
    
    txtScanResult.Text = ""
    cmdStop.Enabled = False
    
End Sub

' ###################################################
' การกดปุ่มให้เริ่มต้น Scan หา Port
' ###################################################
Private Sub cmdScan_Click()
    On Error GoTo ErrorHandler

    Dim Count As Integer
    
    ' ตรวจสอบว่า IP ในการค้นหา ทั้ง 4 ชุด เป็นค่าว่างหรือไม่
    For Count = 0 To 3
        If Trim(txtStartIP(Count).Text) = "" Or Len(Trim(txtStartIP(Count).Text)) = 0 Then
            MsgBox "กรุณาป้อนหมายเลข IP Address ให้ถูกต้องด้วย.", vbOKOnly + vbExclamation, "รายงานสถานะ"
            Exit Sub
        End If
    Next Count
    
    ' ตรวจสอบว่าป้อนหมายเลข Port หรือไม่
    If Trim(txtPort.Text) = "" Or Len(Trim$(txtPort.Text)) = 0 Then
        MsgBox "กรุณาป้อนหมายเลข Port ก่อนด้วย.", vbOKOnly + vbExclamation, "รายงานสถานะ"
        Exit Sub
    End If
    
    ' เคลียร์ข้อมูล Status Bar ช่องแรก
    sbMain.Panels(1).Text = ""
    ' เคลียร์ค่า TextBox ในการแสดงผลหมายเลข IP Address
    txtScanResult.Text = ""
    ' เคลียร์ค่าการนับจำนวน IP
    CountIP = 0
    
    ' กำหนดช่วงเวลาในการ Scan หา IP Address มีหน่วยเป็นมิลลิวินาที โดย 1000 ms = 1 วินาที
    ' บางครั้งก็อาจจะต้องกำหนดให้ใช้เวลานาน เพราะมันขึ้นกับสายและระยะทาง หรืออื่นๆ ด้วยน่ะครับ
    Timer1.Interval = 100
    
    ' หาก IP ชุดสุดท้ายไม่เป็นค่าว่าง
    If Trim(txtEndIP(3).Text) <> "" Or Len(Trim(txtEndIP(3).Text)) = 0 Then
    
        cmdScan.Enabled = False
        cmdStop.Enabled = True
        
        ' แจ้งหมายเลข Port
        txtScanResult.Text = txtScanResult.Text & "ตรวจสอบหมายเลข Port: " & txtPort.Text & vbCrLf
        
        ' กำหนดค่าหมายเลข IP ในการเริ่มต้น Scan หา เอาเฉพาะ 3 ชุดแรก เช่น 192.168.0
        ' แล้วค่อยๆทำการนับหมายเลขชุดสุดท้ายขึ้นไปทีละ 1
        strIP = txtStartIP(0).Text & "." & txtStartIP(1).Text & "." & txtStartIP(2).Text
        
        ' กำหนดหมายเลข IP Address เริ่มต้น (ชุดสุดท้าย)
        IPStartScan = txtStartIP(3).Text
        
        ' กำหนดหมายเลข IP ที่สิ้นสุด (ชุดสุดท้าย)
        IPEndScan = txtEndIP(3).Text
        
        ' ขณะนี้กำลังทำการ Scan เมื่อไรก็ตามที่ค่านี้มีค่าเป็น False ก็จะหยุดการทำงานลงทันที
        blnScan = True
        
        ' กระตุ้นนาฬิกาให้ทำงานต่อไป
        Timer1.Enabled = True
        
    End If
    
ExitProc:
    Exit Sub
    
ErrorHandler:
    
    ' ขณะโปรแกรมกำลังทำงาน (Run Time) ดัก Error จาก On Error GoTo ErrorHandler
    If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    Resume ExitProc
    
End Sub

' ###################################################
' โปรแกรมย่อยในการ Scan หา IP Address ตามช่วงที่กำหนดเอาไว้
' ###################################################
Private Sub ScanIP()

    On Error GoTo ErrorHandler
    
    ' เงื่อนไขให้ Scan เมื่อ IP ชุดสุดท้ายของค่าเริ่มต้น ยังน้อยกว่าหรือเท่ากับ IP ชุดสุดท้ายของค่าสิ้นสุด
    ' และ ยังไม่มีการกดปุ่ม cmdStop ให้หยุดการทำงาน
    If IPStartScan <= IPEndScan And blnScan = True Then
        
        ' ให้ CPU ไปทำงานอย่างอื่นได้เลย (คืน CPU กลับไปให้กับระบบปฏิบัติการ - OS)
        DoEvents
        
        ' หาก Winsock ยังมีการ Connect กับ IP ใดๆอยู่ ต้องสั่งให้ Disconnect ออกไปก่อน
        If wsIP.State <> sckClosed Then wsIP.Close
        
        ' ###################################################
        ' ส่วนสำคัญที่กำหนดค่าเพื่อทำการทดสอบ
        ' กำหนด IP ให้กับ Winsock เมื่อ
        ' strIP เก็บค่า IP 3 ชุดแรก เช่น 192.168.0.111 ก็จะเก็บค่า 192.168.0 เอาไว้
        ' IPStartScan เก็บค่า IP ชุดสุดท้าย หรือ IP ที่กำลังตรวจสอบการ Connect กับ Winsock
        wsIP.RemoteHost = strIP & "." & IPStartScan
        
        ' กำหนดหมายเลข Port ในการติดต่อกับ Remote IP
        wsIP.RemotePort = txtPort.Text
        
        ' Winsock ติดต่อหมายเลข IP Address และ หมายเลข Port ตามที่กำหนด
        ' หวกสามารถติดต่อ IP Address และ Port ที่กำหนดได้ ก็จะกระโดดไปเหตุการณ์ wsIP_Connect()
        ' หากว่ามันติดต่อกับเครื่องปลายทางไม่ได้ มันก็จะไม่กระโดดไปในเหตุการณ์ Connect น่ะครับ
        ' จากนั้นเราก็ให้มันแสดงผลตามหมายเลข IP Address ออกมายังไงล่ะครับ
        ' จะเห็นการทำงานในส่วนนี้ได้ คุณต้องทำการ Debug ดูด้วยน่ะครับ ...
        wsIP.Connect

        ' ###################################################
        
        ' เพิ่มค่า IP ในการ Scan ขึ้นอีก 1
        IPStartScan = IPStartScan + 1
        
    ' Scan หา IP Address ครบแล้ว หรือ สั่งให้หยุดการ Scan
    Else
        
        cmdScan.Enabled = True
        cmdStop.Enabled = False
        
        ' สั่งให้ Timer1 หยุดการทำงานด้วย
        Timer1.Enabled = False
        
        ' รายงานผลการ Scan IP Address ใน StatusBar
        If IPStartScan <= IPEndScan Then
            sbMain.Panels(1).Text = "หยุดการทำงานที่ IP: " & IPStartScan
            
        ' กรณี Scan IP Address เสร็จสมบูรณ์หมดแล้ว
        Else
            sbMain.Panels(1).Text = "การทำงานเสร็จสมบูรณ์ - " & CountIP & " IP Address"
            MsgBox "Scan หา IP ในระบบได้ " & CountIP & " หมายเลข - Port " & txtPort.Text
        End If
    End If
    

ExitProc:
    Exit Sub
    
ErrorHandler:
    
    ' ขณะโปรแกรมกำลังทำงาน (Run Time) ดัก Error จาก On Error GoTo ErrorHandler
    If Err.Number <> 0 Then MsgBox "Error " & Err.Number & vbCrLf & Err.Description
    Resume ExitProc
    
End Sub

' ###################################################
' ตราบใดที่ Timer1.Enabled = True มันก็จะเข้ามาทำงานที่นี่ ตามค่า Interval ที่ตั้งเอาไว้
' ###################################################
Private Sub Timer1_Timer()
    ' หาก Timer1 มีค่า Enabled ก็จะสั่งให้ไปทำงานที่โปรแกรมย่อย ScanIP ตามเวลาที่กำหนด
    sbMain.Panels(1).Text = "กำลังประมวลผล IP: " & strIP & "." & IPStartScan
    
    ' ไป Scan หา IP Address หรือ
    ' ตรวจสอบการ Connect IP Address กับ Winsock Control นั่นแหละครับ
    Call ScanIP

End Sub

' ###################################################
' โปรแกรมย่อยในการตรวจสอบการ Connect กับ Winsock หรือไม่
' หากมีการ Connect กับ IP ที่ทดสอบอยู่ให้ทำการแจ้งผลใน TextBox
Private Sub wsIP_Connect()
' ###################################################

On Error GoTo ErrorHandler
    
    ' แสดงหมายเลข IP Address และ DNS
    txtScanResult.Text = txtScanResult.Text & "IP : " & _
            wsIP.RemoteHost & " - " & _
            IPtoDNS(wsIP.RemoteHost) & vbCrLf
    
    ' นับจำนวน IP Address ที่ตรวจพบ
    CountIP = CountIP + 1
    
ExitProc:
    Exit Sub

ErrorHandler:
    
    ' ขณะโปรแกรมกำลังทำงาน (Run Time) ดัก Error จาก On Error GoTo ErrorHandler
    If Err.Number <> 0 Then MsgBox "Error " & Err.Number & vbCrLf & Err.Description
    Resume ExitProc

End Sub