form1.frm

一款宽带自动拨号的程序

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4980
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6975
   LinkTopic       =   "Form1"
   ScaleHeight     =   4980
   ScaleWidth      =   6975
   StartUpPosition =   3  '窗口缺省
   Begin MSAdodcLib.Adodc Adodc2 
      Height          =   375
      Left            =   480
      Top             =   4200
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   2
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\new\桌面\hzadsl\hzcnc.mdb;Persist Security Info=False"
      OLEDBString     =   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\new\桌面\hzadsl\hzcnc.mdb;Persist Security Info=False"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "cnc1"
      Caption         =   "Adodc2"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   375
      Left            =   480
      Top             =   3600
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   2
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\new\桌面\hzadsl\hzcnc.mdb;Persist Security Info=False"
      OLEDBString     =   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\new\桌面\hzadsl\hzcnc.mdb;Persist Security Info=False"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "cnc"
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "执行"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   1080
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'有关的API声明和定义*/
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
  
'函数IsConnected返回连通的状态，如果为True则表示已连通*/
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 "错误"
    Exit Function
  End If
  Tstatus.dwSize = 160
  RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
  If Tstatus.RasConnState = &H2000 Then
    IsConnected = True
  Else
    IsConnected = False
  End If
End Function


Private Sub Command1_Click()
Dim aa(1 To 26000) As String
Dim bb(1 To 26000) As String
Dim cc As String, dd As String, ee As String
Dim k As Long, m As Long

Dim res
Dim i As Integer
cc = InputBox("请输入下限(1--25885)", "定义范围", 1)
dd = InputBox("请输入上限(1--25885)", "定义范围", 1)
res = Shell("rasphone.exe [-d 宽带连接]", 1)

For i = Val(cc) To Val(dd)
  If IsConnected = True Then
SendKeys "{enter}", True
SendKeys "{enter}", True
 SendKeys "%{F4}", True
  End If

   Adodc1.CommandType = adCmdText
   Adodc1.RecordSource = "SELECT * from cnc WHERE id = '" & i & "' "
   Adodc1.Refresh
   Adodc1.Recordset.MoveFirst
   aa(i) = Adodc1.Recordset.Fields("username")
   bb(i) = Adodc1.Recordset.Fields("password")
   

  If IsConnected = False Then
res = Shell("rasphone.exe [-d 宽带连接]", 1)
SendKeys "{enter}", True
SendKeys aa(i), True
SendKeys "{tab}", True
SendKeys bb(i), True
SendKeys "{enter}", True

For m = 1 To 100000
  If IsConnected = True Then
   Adodc1.Recordset.Fields("ps") = 1
   Adodc1.Recordset.Update

  End If
Next

  If IsConnected = False Then
   Adodc1.Recordset.Fields("ps") = 2
     Adodc1.Recordset.Update
     
   End If
 SendKeys "%{F4}", True
 'SendKeys "%{F4}", True

End If
Next


End Sub