Source Code โปรแกรมตรวจสอบและบันทึกการเชื่อมต่ออินเทอร์เน็ต (ภาค 2 ตอนง่าย)

Option Explicit

' =============================================================
' Application Programming Interface (API) สำหรับตรวจสอบการเชื่อมต่ออินเทอร์เน็ต
' =============================================================
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" ( _
    ByRef lpdwFlags As Long, _
    ByVal lpszConnectionName As String, _
    ByVal dwNameLen As Integer, _
    ByVal dwReserved As Long _
    ) As Long
    
' ใช้นับเวลาตามเวลาที่ตั้งเอาไว้ (1 - 60 นาที)
Private CountTime As Integer

' =====================================================
' โปรแกรมย่อย (ฟังค์ชั่น) ตรวจสอบการเชื่อมต่ออินเทอร์เน็ตหรือไม่
' =====================================================
Public Function CheckConnection() As Boolean
    ' จองพื้นที่ไว้ 255 ไบต์ เพื่อระบุการเชื่อมต่ออินเทอร์เน็ต
    Dim Buffer As String * 255
    
    ' ===================================================
    Dim lpdwFlags As Long
    ' อ่านรายละเอียดเพิ่มเติมที่
    ' http://msdn.microsoft.com/en-us/library/aa384705(VS.85).aspx
    ' http://msdn.microsoft.com/en-us/library/aa920300.aspx
    ' ===================================================
    
    Dim Flags As Long
    
    Flags = InternetGetConnectedStateEx(lpdwFlags, Buffer, 255, 0)
    ' หาก Flags มีค่าเป็น 0 จะเกิด Error (เหมือนกับ Win32 API ทั่วๆไป)
    ' (ฟังค์ชั่นที่ส่งค่ากลับมาโดยไม่เป็น 0 แสดงว่าทำงานได้ไม่มีข้อผิดพลาด)
    If Flags <> 0 Then
        CheckConnection = True
    Else
        CheckConnection = False
    End If

End Function

Private Sub Form_Load()
' หากว่าไฟล์ Logging.txt ไม่มี จะเกิดข้อผิดพลาดเกิดขึ้นที่คำสั่ง Kill ทันที
' ดังนั้นผมไม่สนใจ Error ที่เกิดขึ้น จึงต้องกำหนดให้เป็น Resume Next ... คือ ทำงานต่อไปได้เลย
On Error Resume Next
' จะมีผลเฉพาะโปรแกรมย่อย Form_Load นี้เท่านั้นน่ะครับ

    
    ' ตั้งหน้าจอโปรแกรมอยู่ตำแหน่งกึ่งกลางจอภาพ
    ' การใช้หารตัดเศษ (\) จะทำงานได้เร็วกว่าการหารที่มีเศษ
    ' นี่ก็อีกเทคนิคของการ Optimized แม้เป็นเพียงจุดเล็กๆ เสียวเสี้ยวหนึ่งในโปรแกรม ... 55555+
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    
    Dim i As Integer
    For i = 1 To 60
        cmbMinute.AddItem i
    Next
    cmbMinute.ListIndex = 0
    
    rtfLog.Text = ""
    Timer1.Enabled = False
    cmdStop.Enabled = False
    
    ' ตั้งค่าการกระตุ้น (Trigger) Timer1 ทุกๆ 1 นาที
    ' เมื่อ 1000 Millisecond = 1 วินาที
    ' 60 x 1000 = 60000 หรือ 1 นาที
    Timer1.Interval = 60000
    ' กรณีต้องการทดสอบทุกๆวินาที
    'Timer1.Interval = 1000
    
    CountTime = 0

    ' =============== การเคลียร์ข้อมูลใน Text File ============
    ' ลบไฟล์ Logging.txt ของเดิมทิ้งไปได้เลย ... 55555+
    'Kill App.Path & "\Logging.txt"
    ' หรือ ...
    Open App.Path & "\Logging.txt" For Output As #1
    Close #1
    ' ===============================================
    
End Sub

' ========================================================
' ส่วนของ Timer1 จะถูกกระตุ้นการทำงาน ตามเวลาที่ตั้งเอาไว้ เพื่อบันทึกรายงานผล
' ========================================================
Private Sub Timer1_Timer()

    ' จะมาทำงานในโปรแกรมย่อยนี้ทุกๆ 1 นาที ซึ่งมาทีไรก็ให้เพิ่มค่าขึ้น 1 ทุกที
    ' 1 ที่ว่ามานี้ มันก็คือ 1 นาทีนั่นเองแหละ
    CountTime = CountTime + 1
    
    If CountTime >= cmbMinute.Text Then
        ' เคลียร์ค่า เพื่อเริ่มการนับเวลาใหม่
        CountTime = 0
        Call LogFile
    End If
    
    ' กรณีทดสอบทุกๆวินาที ให้ใส่ Comment (') คำสั่งทางด้านบนให้หมด และ ...
    ' ให้ไปทำงานในโปรแกรมย่อย Call LogFile
    
End Sub

' ========================================================
' โปรแกรมย่อยเพื่อทำการเก็บสถิติการเชื่อมต่ออินเทอร์เน็ต
' ========================================================
Private Sub LogFile()

Dim PublicIP As String
Dim Str As String
Dim StartIP As Long, EndIP As Long
    
' ส่วนของการทำ Logging File โดยการเรียกใช้งานผ่านทาง
' Project --> Preferences --> Microsoft Scripting Runtime
Dim MyFSO As New FileSystemObject, LoggingFile
Dim LogStream As TextStream

    If Dir(App.Path & "\Logging.txt") = "" Then _
            Set LoggingFile = MyFSO.CreateTextFile(App.Path & "\Logging.txt", True)
    ' ============================================================
    Set LoggingFile = MyFSO.GetFile(App.Path & "\Logging.txt")
    ' เมื่อเจอไฟล์ที่ต้องการก็ทำการบันทึกข้อมูลลงไปต่อท้ายไฟล์เลย (ForAppending)
    Set LogStream = LoggingFile.OpenAsTextStream(ForAppending)
    ' ============================================================
    
    ' หากต่ออินเทอร์เน็ตได้
    If CheckConnection Then
        ' เลือก Component --> MS Internet Transfer Control มาด้วยน่ะครับ
        Str = Inet1.OpenURL("http://www.g2gnet.com/MyIP.asp")
        ' หรือท่านที่ชื่นชอบ PHP Script ... ลองทดสอบที่ Server ผมก็ได้น่ะครับ
        'Str = Inet1.OpenURL("http://www.g2gnet.com/MyIP.php")
        ' พี่น้องครับ ... Windows Server สามารถรัน ASP และ PHP Script ได้ด้วยน่ะครับ
        ' แต่ Linux ไม่อาจจะมาเทียบชั้น หรือ ตีเสมอ ได้กับเล็กนิ่ม ... เอิ๊กๆๆๆๆ
        
        If Len(Str) > 0 Then
            ' ===================================================
            ' จะส่งค่าให้หรือไม่ก็ได้ครับ ... แต่ผมแค่ทำเอาไว้ให้ดู
            PublicIP = Str
            ' บันทึกลงไฟล์
            LogStream.WriteLine "Net Link : " & PublicIP & " วันที่ - เวลา " & Now()
            ' ===================================================
        End If
        
    ' อินเทอร์เน็ตดาวน์ล่ะครับ
    Else
        LogStream.WriteLine "Net Down : วันที่ - เวลา " & Now()
    End If
    
    LogStream.Close
    rtfLog.LoadFile LoggingFile

End Sub

Private Sub cmdExit_Click()
    Set frmCheckInternet = Nothing
    End
End Sub

Private Sub cmdStart_Click()
    ' เริ่มต้นการทำงาน
    Timer1.Enabled = True
    cmbMinute.Enabled = False
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    
End Sub

Private Sub cmdStop_Click()
    ' หยุดการทำงาน
    Timer1.Enabled = False
    cmbMinute.Enabled = True
    cmdStart.Enabled = True
    cmdStop.Enabled = False
End Sub