📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "自动上网计时"
ClientHeight = 2895
ClientLeft = 60
ClientTop = 345
ClientWidth = 5040
LinkTopic = "Form1"
ScaleHeight = 2895
ScaleWidth = 5040
StartUpPosition = 2 '屏幕中心
Begin VB.Timer OnlineTimer
Enabled = 0 'False
Interval = 1000
Left = 2040
Top = 1200
End
Begin VB.CommandButton Command1
Caption = "自动计时"
Height = 375
Left = 3240
TabIndex = 0
Top = 720
Width = 1335
End
Begin VB.Timer AutoTimer
Enabled = 0 'False
Interval = 500
Left = 1440
Top = 1200
End
Begin VB.Label Now_Hour
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Left = 960
TabIndex = 6
ToolTipText = "您本次上网使用的时间（小时）"
Top = 720
Width = 135
End
Begin VB.Label LabHour
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "小时"
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 1215
TabIndex = 5
Top = 750
Width = 360
End
Begin VB.Label Now_Minute
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Left = 1695
TabIndex = 4
ToolTipText = "您本次上网使用的时间（分钟）"
Top = 720
Width = 135
End
Begin VB.Label LabMinute
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "分钟"
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 1935
TabIndex = 3
Top = 750
Width = 360
End
Begin VB.Label Now_Second
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Left = 2415
TabIndex = 2
ToolTipText = "您本次上网使用的时间（秒钟）"
Top = 720
Width = 135
End
Begin VB.Label LabSecond
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "秒"
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 2655
TabIndex = 1
Top = 750
Width = 180
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function RegCloseKey Lib "Advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RegOpenKey Lib "Advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "Advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const APINULL = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceName = 128
Const RAS_MaxDeviceType = 16
Private Type RASCONN95
'Set dWsize to 412
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Sub AutoTimer_Timer()
If Fun_Activeconnection = True And Fun_TestOnline = True Then
'
'已连上 Internet
'
If OnlineTimer.Enabled = False Then
OnlineTimer.Enabled = True
End If
Else
'
'没连上 Internet
'
If OnlineTimer.Enabled = True Then OnlineTimer.Enabled = False
End If
End Sub
Private Sub OnLineTimer_Timer()
Now_Second.Caption = Now_Second.Caption + 1 '每秒+1
'
'现在上网时间
'
If Now_Second.Caption >= 60 Then Now_Second.Caption = 0: Now_Minute.Caption = Now_Minute.Caption + 1
If Now_Minute.Caption >= 60 Then Now_Minute.Caption = 0: Now_Second.Caption = 0: Now_Hour.Caption = Now_Hour.Caption + 1
End Sub
'-------------------------------------------------
'函数:用拨号网络的函数RasHangUp 检测是否正在连上Internet
'-------------------------------------------------
Private Function Fun_TestOnline() As Boolean
Dim lngRetCode As Long, lpcb As Long, lpcConnections As Long
Dim intArraySize As Integer, intLooper As Integer
ReDim lprasconn95(intArraySize) As RASCONN95
Fun_TestOnline = False
lprasconn95(0).dwSize = 412
lpcb = 256 * lprasconn95(0).dwSize
lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
If lngRetCode = 0 Then '检测是否正在连上Internet
If lpcConnections > 0 Then
Fun_TestOnline = True '已经连上网
Else
Fun_TestOnline = False '没有连上网
End If
End If
End Function
'--------------------------------
'函数:用注册表检测是否正在连上Internet
'--------------------------------
Private Function Fun_Activeconnection() As Boolean
Dim ReturnCode As Long, hKey As Long, lpSubKey As String
Dim phkResult As Long, lpValueName As String, lpReserved As Long
Dim lpType As Long, lpData As Long, lpcbData As Long
Fun_Activeconnection = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then '检测是否正在连上Internet
If lpData = 0 Then
Fun_Activeconnection = False '没有连上网
Else
Fun_Activeconnection = True '已经连上网
End If
End If
RegCloseKey (hKey)
End If
End Function
Private Sub Command1_Click()
AutoTimer.Enabled = True
Command1.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -