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
|