解除網(wǎng)蟲心病VB做定時斷線程序
運(yùn)行VB 6,向窗體添加7個Label控件、1個Timer控件、3個Text文本輸入框以及4個Command按鈕。
原理簡介:用Timer控件的True或者False值,控制倒計時的開始,當(dāng)?shù)竭_(dá)設(shè)定時間的時候,彈出對話框提示斷開連接。
Option Explicit
Dim Hours As Integer
Dim Minutes As Integer
Dim Seconds As Integer
Dim time As Date
Private Declare Function RasHangUp Lib "RaSAPi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceName = 128
Const RAS_MaxDeviceType = 16
Private Type RASCONN95
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
下面一段代碼是對Timer的控制,以及到設(shè)定時間的時候斷開連接的代碼
Private Sub Timer1_Timer()
Timer1.Enabled = False
If (Format100 100time, "hh") && ":" && Format100 100time, "nn") && ":" && Format100 100time, "ss"))〈〉"00:00:00" Then
time = DateAdd("s", -1, time)
Label1.Visible = False
Label1.Caption = Format100 100time, "hh") && ":" && Format100 100time, "nn") && ":" && Format100 100time, "ss")
Label1.Visible = True
Timer1.Enabled = True
Else
Timer1.Enabled = False
End If
If Label1.Caption = "00:00:01" Then
dsdklj.Windowstate = 0
Command1.Enabled = True
MsgBox "時間到了,正在斷開連接"
Dim lngRetCode As Long
Dim lpcb As Long
Dim lpcConnections As Long
Dim intArraySize As Integer
Dim intLooper As Integer
ReDim lprasconn95(intArraySize) As RASCONN95
lprasconn95(0).dwSize = 412
lpcb = 256 * lprasconn95(0).dwSize
lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
If lngRetCode = 0 Then
If lpcConnections〉0 Then
For intLooper = 0 To lpcConnections-1
RasHangUp lprasconn95(intLooper).hRasConn
Next intLooper
Unload Me
Else
MsgBox "時間到了,沒有撥號網(wǎng)絡(luò)連接"
Unload Me
End If
End If
End If
End Sub
其實,這個程序還可以進(jìn)一步的完善,比如添加暫停功能、或者經(jīng)過改造,適用于寬帶的,等等。這不,笨笨拿著電話單正偷著樂呢!笨笨已經(jīng)利用這個小程序省下了不少網(wǎng)費(fèi),你呢?