form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Form1 
   Caption         =   "网络计时器"
   ClientHeight    =   2460
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5730
   LinkTopic       =   "Form1"
   ScaleHeight     =   2460
   ScaleWidth      =   5730
   StartUpPosition =   1  '所有者中心
   Begin MSComCtl2.DTPicker DTP1 
      Height          =   315
      Left            =   1485
      TabIndex        =   6
      Top             =   630
      Width           =   3795
      _ExtentX        =   6694
      _ExtentY        =   556
      _Version        =   393216
      Format          =   24444930
      CurrentDate     =   36635
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   405
      Left            =   3990
      TabIndex        =   5
      Top             =   1920
      Width           =   1275
   End
   Begin VB.TextBox Text2 
      Height          =   315
      Left            =   1485
      TabIndex        =   1
      Top             =   1470
      Width           =   3800
   End
   Begin VB.TextBox Text1 
      Height          =   315
      Left            =   1485
      TabIndex        =   0
      Top             =   1050
      Width           =   3800
   End
   Begin VB.Timer Timer1 
      Interval        =   800
      Left            =   90
      Top             =   1725
   End
   Begin VB.Label Label5 
      Height          =   315
      Left            =   660
      TabIndex        =   8
      Top             =   1950
      Width           =   3165
   End
   Begin VB.Label Label4 
      Caption         =   "上网次数："
      Height          =   255
      Left            =   450
      TabIndex        =   7
      Top             =   1515
      Width           =   1125
   End
   Begin VB.Label Label3 
      Caption         =   "网络计时器"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   465
      Left            =   2055
      TabIndex        =   4
      Top             =   90
      Width           =   1875
   End
   Begin VB.Label Label2 
      Caption         =   "时间总计："
      Height          =   255
      Left            =   465
      TabIndex        =   3
      Top             =   1110
      Width           =   1125
   End
   Begin VB.Label Label1 
      Caption         =   "上网时间："
      Height          =   255
      Left            =   465
      TabIndex        =   2
      Top             =   690
      Width           =   1125
   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 RasEnumConnections Lib "RasApi32.dll" Alias _
    "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, _
    lpcConnections As Long) As Long
    
Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias _
    "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long

Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceType = 16
Const RAS95_MaxDeviceName = 32

Private Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Private Type RASCONN95
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Dim i As Integer

Private Sub Form_Load()
  i = 0
End Sub

Private Sub Timer1_Timer()
  Dim TRasCon(255) As RASCONN95
  Dim lg As Long
  Dim lp As Long
  Dim RetVal As Long
  Dim status As RASCONNSTATUS95
  
  TRasCon(0).dwSize = 412
  lg = 256 * TRasCon(0).dwSize
  RetVal = RasEnumConnections(TRasCon(0), lg, lp)
  If RetVal <> 0 Then
     Exit Sub
  End If
  status.dwSize = 160
  RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, status)
  If status.RasConnState = &H2000 Then
     If i = 0 Then
        DTP1.Value = Time
        i = 1
        Text2.Text = Val(Text2.Text) + 1
      Else
        Text1.Text = Time - DTP1.Value
        Text1.Text = Format(Text1.Text, "hh:mm:ss ")
     End If
     Label5.Caption = "已连接到Internet!"
   Else
     i = 0
     Label5.Caption = "未连接到Internet!"
  End If
End Sub

Private Sub Command1_Click()
  End
End Sub