📄 frmdialupmanage0308.frm
字号:
Begin VB.CommandButton Command7
Caption = "修改口令(&E)"
Height = 270
Left = 3465
TabIndex = 12
Top = 1770
Width = 1200
End
Begin VB.CommandButton Command6
Caption = "视觉改变(&K)"
Height = 300
Left = 4965
TabIndex = 11
Top = 1371
Width = 1290
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 330
Left = 0
TabIndex = 10
Top = 2580
Width = 6465
_ExtentX = 11404
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 4
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3421
MinWidth = 3421
Text = "状态"
TextSave = "状态"
Object.ToolTipText = "当前网络状态"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Text = "方式"
TextSave = "方式"
Object.ToolTipText = "当前上网接入方式"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3069
MinWidth = 3069
Text = "开始时间"
TextSave = "开始时间"
Object.ToolTipText = "当前上网接入起始时间"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3069
MinWidth = 3069
Text = "结束时间"
TextSave = "结束时间"
Object.ToolTipText = "当前上网结束时间"
EndProperty
EndProperty
End
Begin VB.TextBox Text1
Height = 270
IMEMode = 3 'DISABLE
Left = 1380
PasswordChar = "@"
TabIndex = 8
Top = 1800
Width = 1905
End
Begin VB.ListBox List1
Height = 1320
Left = 165
TabIndex = 5
Top = 360
Width = 4515
End
Begin VB.CommandButton Command5
Caption = "退出程序(&Q)"
Height = 300
Left = 4964
TabIndex = 4
Top = 2205
Width = 1290
End
Begin VB.CommandButton Command4
Caption = "关于程序(&A)"
Height = 300
Left = 4959
TabIndex = 3
Top = 1788
Width = 1290
End
Begin VB.CommandButton Command3
Caption = "系统设置(&S)"
Height = 300
Left = 4949
TabIndex = 2
Top = 954
Width = 1290
End
Begin VB.CommandButton Command2
Caption = "断线下网(&C)"
Height = 300
Left = 4954
TabIndex = 1
Top = 537
Width = 1290
End
Begin VB.CommandButton Command1
Caption = "拨号上网(&B)"
Height = 300
Left = 4944
TabIndex = 0
Top = 120
Width = 1290
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 180
Left = 150
OleObjectBlob = "frmDialupManage0308.frx":083A
TabIndex = 6
Top = 135
Width = 2610
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2
Height = 195
Left = 150
OleObjectBlob = "frmDialupManage0308.frx":08A7
TabIndex = 7
Top = 1845
Width = 1170
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 360
Left = 135
OleObjectBlob = "frmDialupManage0308.frx":090E
TabIndex = 9
Top = 2145
Width = 1005
End
Begin VB.Menu mnuTray
Caption = "Popup"
Visible = 0 'False
Begin VB.Menu mnuTrayRestore
Caption = "显示主界面(&M)"
End
Begin VB.Menu mnuTrayChaJian
Caption = "插件"
Begin VB.Menu mnuTrayDialMeter
Caption = "网速流量计"
End
Begin VB.Menu mnuTrayAutoMialCheck
Caption = "邮件自动检查器"
End
Begin VB.Menu menuty2
Caption = "-"
End
Begin VB.Menu mnuTrayMailCheckSetup
Caption = "邮件检查配置"
End
End
Begin VB.Menu menuty1
Caption = "-"
End
Begin VB.Menu mnuTrayClose
Caption = "断线下网(&C)"
End
End
Begin VB.Menu menutyskin
Caption = "SkinMenu"
Visible = 0 'False
Begin VB.Menu menutyskin1
Caption = ""
End
Begin VB.Menu menutyskin2
Caption = ""
End
Begin VB.Menu menutyskin3
Caption = ""
End
Begin VB.Menu menutyskin4
Caption = ""
End
Begin VB.Menu menutyskin5
Caption = ""
End
Begin VB.Menu menutyskin6
Caption = ""
End
Begin VB.Menu menutyskin7
Caption = ""
End
Begin VB.Menu menutyskin8
Caption = ""
End
End
End
Attribute VB_Name = "frmDialupManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'--------系统托盘api
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public LastState As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
'----------
Dim fromrs As Boolean
Dim UserID As Integer
Dim DialType As String, DialUser As String, DialPass As String
Dim StartTime As String, EndTime As String
Dim hyperjump
'启动拨号网络
'利用RasEnumConnections函数，就可以得到所需拨号网络连接的句柄
'---------------------------------------------------------------
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 '设置 dWsize 值为 412
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'-----------方式
Private Enum ConType
LAN = 1
MODEM = 2
NONE = 3
ALREADY = 4
End Enum
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpSFlags As Long, ByVal dwReserved As Long) As Long
Private hconn As Long
Const ProgTitle = "拨号上网管理器 v1.0"
Const MSG1 = "错误，端口已经打开！"
Const MSG2 = "错误，未知的错误！"
Const MSG3 = "错误，请求超时！"
Const MSG4 = "错误，您没有输入密码！"
Const MSG5 = "错误，没有拨号音！"
Const MSG6 = "错误，拨入的远程计算机没有响应！"
Const MSG7 = "错误，未知的响应！"
Const MSG8 = "错误，没有响应！"
Const MSG9 = "错误，设备没有准备好！"
Const MSG10 = "错误，占线！"
Const MSG11 = "错误，没有应答信号！"
Const MSG12 = "错误，没有载波信号！"
Const MSG13 = "错误，没有拨号音！"
Const MSG14 = "错误，用户名密码出错！"
Const MSG15 = "错误，PPP接入超时！"
Const MSG16 = "错误，网络设备不存在或没打开电源！"
Const MSG17 = "错误，请建立新连接！"
'键常数
Const hKey = HKEY_CURRENT_USER
Const CreateKeyA = "Software\Mndsoft\Property\" '属性参数
Const SetKeyPropertyA = "Software\Mndsoft\Property\DialUserList" '用户列表
Const SetKeyPropertyB = "Software\Mndsoft\Property\DialSetting" '拨号属性
Const SetKeyPropertyC = "Software\Mndsoft\Property\DialOther" '其他属性
'Win98
'Const DEDialNetWork = "Software\Mndsoft\Property\DialOther" '其他属性
' CreateNewKey(HKEY_CURRENT_USER, "Software\Mndsoft\Property\DialOther")
' SetKeyValue(HKEY_CURRENT_USER, "Software\Mndsoft\Property\DialOther", "Level1", "*$%^$^$", REG_SZ)
'--------动画菜单
Private WithEvents SysTray As CSysTray
Attribute SysTray.VB_VarHelpID = -1
'断开网络连接
Private Const RAS_MAXENTRYNAME = 256
'Private Const RAS_MAXDEVICETYPE = 16
Private Const RAS_MAXDEVICENAME = 128
Private Const RAS_RASCONNSIZE = 412
Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
'Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "RasApi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
'--------------------------------
Private Sub Check2_Click()
Text8 = "http://www.china-huahang.com/main.shtml"
If Check2.Value = 1 Then
Text8.Enabled = False
Else
Text8.Enabled = True
End If
End Sub
Private Sub Check5_Click()
Call SetKeyValue(hKey, SetKeyPropertyC, "IEWizards", Check5.Value, REG_DWORD)
End Sub
'禁止设置IE连接选项
Private Sub Check6_Click()
Call SetKeyValue(hKey, SetKeyPropertyC, "ConnectOption", Check6.Value, REG_DWORD)
End Sub
'在我的电脑中显示隐藏拨号网络
Private Sub Check7_Click()
If Check7.Value = 1 Then
Call DeleteKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\explorer\MyComputer\NameSpace\{992CFFA0-F557-101A-88EC-00DD010CCC48}")
Else
Call CreateNewKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\explorer\MyComputer\NameSpace\{992CFFA0-F557-101A-88EC-00DD010CCC48}") '其他
End If
End Sub
Private Sub Combo1_Click()
rasDialer.PhoneEntry = Combo1.Text
If rasDialer.AutoUpdate Then
'editPhoneNumber.Text = rasDialer.PhoneNumber
Text6.Text = rasDialer.UserName
Text7.Text = rasDialer.Password
'editDomain.Text = rasDialer.UserDomain
Else
'editPhoneNumber.Text = ""
Text6.Text = ""
Text7.Text = ""
'editDomain.Text = ""
End If
End Sub
'拨号上网
Private Sub Command1_Click()
'SaveSetting App.EXEName, "Settings", "MainLeft", frmMain.Left
'GetSetting(App.EXEName, "Options", "Show Tips at Startup", 1)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -