form1.frm

收集的100多个适合不同层次VB爱好者编程的实例源码

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H80000004&
   Caption         =   "监视网络联接"
   ClientHeight    =   3675
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5385
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3675
   ScaleWidth      =   5385
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "清除历史记录(&C)"
      Height          =   615
      Left            =   3360
      MaskColor       =   &H00FFFFFF&
      TabIndex        =   7
      Top             =   840
      Width           =   1935
   End
   Begin VB.TextBox Text4 
      DataField       =   "TransactionType"
      DataSource      =   "Data1"
      Height          =   615
      Left            =   2040
      TabIndex        =   6
      Text            =   "Text4"
      Top             =   1440
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox Text3 
      DataField       =   "DateTime"
      DataSource      =   "Data1"
      Height          =   615
      Left            =   1680
      TabIndex        =   5
      Text            =   "Text3"
      Top             =   2040
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "D:\vb稿件\69监视网络联接\netLog.mdb"
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   2280
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "Log"
      Top             =   3120
      Visible         =   0   'False
      Width           =   1140
   End
   Begin VB.CommandButton Command1 
      Caption         =   "隐藏本窗口(&H)(按F9显示)"
      Height          =   615
      Left            =   3360
      MaskColor       =   &H00FFFFFF&
      TabIndex        =   4
      Top             =   1800
      Width           =   1935
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   3600
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   3120
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   960
      Top             =   1320
   End
   Begin VB.ListBox List1 
      Height          =   2040
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   2895
   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "完成"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   2880
      Width           =   2895
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Label2"
      ForeColor       =   &H80000007&
      Height          =   195
      Left            =   1320
      TabIndex        =   2
      Top             =   120
      Width           =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H80000004&
      Caption         =   "目前状态:"
      ForeColor       =   &H80000007&
      Height          =   180
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   810
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim results As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

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
'
Private Const RAS95_MaxEntryName = 256
Private Const RAS95_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 32
'
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
'
Private Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Dim laststausOn As Boolean
Dim connect As Boolean
Private Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize

RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
 MsgBox "ERROR"
  Exit Function
End If
'
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
  IsConnected = True
    connect = True
Else
   IsConnected = False
   connect = False
End If
 
End Function

Private Sub Command1_Click()
Form1.Hide
End Sub

Private Sub Command2_Click()
Label3.Caption = "Clearing history..."
Data1.RecordsetType = 0
Data1.Refresh
For i = 1 To Data1.Recordset.RecordCount
Data1.Recordset.MoveFirst
Data1.Recordset.Delete
Next
List1.Clear
Label3.Caption = "Done"
End Sub

Private Sub Form_Load()
'Form1.Hide
App.TaskVisible = False
Data1.DatabaseName = App.Path & "\netLog.mdb"
End Sub

Private Sub List1_Click()

End Sub

Private Sub Text1_Change()
Data1.RecordsetType = 1
Data1.Refresh
If Text1.Text = True Then
Data1.Recordset.AddNew
Text4.Text = "Connected"
Text3.Text = Now
Data1.Recordset.Update
Data1.Refresh
List1.AddItem "Connected at " & Now
Label2.ForeColor = &HFF00&
ElseIf Text1.Text = "False" Then
Data1.Recordset.AddNew
Text4.Text = "Disconnected"
Text3.Text = Now
Data1.Recordset.Update
Data1.Refresh
Label2.ForeColor = &HFF&
List1.AddItem "Disconnected at " & Now
End If

End Sub

Private Sub Timer1_Timer()
IsConnected
If connect = True Then
Label2.Caption = "Connected"
Else
Label2.Caption = "Not Connected"
End If

Text1.Text = connect
 
For i = 1 To 255
results = 0
results = GetAsyncKeyState(i)
If results <> 0 And i = 120 Then
Form1.Show
End If
Next

End Sub