📄 frmdialupmanageold.frm
字号:
TextSave = "结束时间"
Object.ToolTipText = "当前上网结束时间"
EndProperty
EndProperty
End
Begin VB.TextBox Text1
Height = 285
IMEMode = 3 'DISABLE
Left = 1425
PasswordChar = "#"
TabIndex = 8
Top = 1155
Width = 1905
End
Begin VB.ListBox List1
Height = 780
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 = "frmDialupManage.frx":0886
TabIndex = 6
Top = 135
Width = 2610
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2
Height = 195
Left = 180
OleObjectBlob = "frmDialupManage.frx":08F3
TabIndex = 7
Top = 1215
Width = 1290
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 210
Left = 180
OleObjectBlob = "frmDialupManage.frx":095A
TabIndex = 9
Top = 1530
Width = 2010
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
End
Attribute VB_Name = "frmDialupManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'--------系统托盘api
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 = "错误，网络设备不存在或没打开电源！"
'--------动画菜单
Private WithEvents SysTray As CSysTray
Attribute SysTray.VB_VarHelpID = -1
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 Command1_Click()
'SaveSetting App.EXEName, "Settings", "MainLeft", frmMain.Left
'GetSetting(App.EXEName, "Options", "Show Tips at Startup", 1)
Dim temp As Long
If List1.Text = "" Then
MsgBox "我不知道您是谁，我不好记录您的操作哎,看用户列表中有没有您的大名!", vbCritical, ProgTitle
List1.SetFocus
Exit Sub
End If
'校验密码
If Trim(Text1) <> DeCrypt(Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPass" & Trim(Str(List1.ListIndex)), "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPass" & Trim(Str(List1.ListIndex)), ""))) - 1), "Mndsoft") Then
MsgBox "这好像不是您的密码哎,仔细想想!", vbCritical, ProgTitle
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Text1.SetFocus
Exit Sub
End If
'校验工作内容
If Checkstr(Text2) = 0 Then
MsgBox "您好像英文很好哎,对不起,咱中国人说国语,用汉字:-)", vbCritical, ProgTitle
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
Text2.SetFocus
Exit Sub
End If
If Combo1.Text = "" Or Text6.Text = "" Or Text7.Text = "" Then
temp = MsgBox("您没有输入有效的拨号网络参数!若您是超级用户请到系统设置中设置!", vbExclamation, "错误")
Exit Sub
End If
temp = AddConnection("", Combo1.Text, "", Text6.Text, Text7.Text) ', "BJSAEA"
Select Case temp
Case ERROR_PORT_ALREADY_OPEN: temp = MsgBox(MSG1, vbExclamation, ProgTitle)
Call RecoreErr(MSG1)
StatusBar1.Panels(1).Text = MSG1
Case ERROR_UNKNOWN: temp = MsgBox(MSG2, vbExclamation, ProgTitle)
Call RecoreErr(MSG2)
StatusBar1.Panels(1).Text = MSG2
Case ERROR_REQUEST_TIMEOUT: temp = MsgBox(MSG3, vbExclamation, ProgTitle)
Call RecoreErr(MSG3)
StatusBar1.Panels(1).Text = MSG3
Case ERROR_PASSWD_EXPIRED: temp = MsgBox(MSG4, vbExclamation, ProgTitle)
Call RecoreErr(MSG4)
StatusBar1.Panels(1).Text = MSG4
Case ERROR_NO_DIALIN_PERMISSION: temp = MsgBox(MSG5, vbExclamation, "拨号管理器 v1.0r")
Call RecoreErr(MSG5)
StatusBar1.Panels(1).Text = MSG5
Case ERROR_SERVER_NOT_RESPONDING: temp = MsgBox(MSG6, vbExclamation, ProgTitle)
Call RecoreErr(MSG6)
StatusBar1.Panels(1).Text = MSG6
Case ERROR_UNRECOGNIZED_RESPONSE: temp = MsgBox(MSG7, vbExclamation, ProgTitle)
Call RecoreErr(MSG7)
StatusBar1.Panels(1).Text = MSG7
Case ERROR_NO_RESPONSES: temp = MsgBox(MSG8, vbExclamation, ProgTitle)
Call RecoreErr(MSG8)
StatusBar1.Panels(1).Text = MSG8
Case ERROR_DEVICE_NOT_READY: temp = MsgBox(MSG9, vbExclamation, ProgTitle)
Call RecoreErr(MSG9)
StatusBar1.Panels(1).Text = MSG9
Case ERROR_LINE_BUSY: temp = MsgBox(MSG10, vbExclamation, ProgTitle)
Call RecoreErr(MSG10)
StatusBar1.Panels(1).Text = MSG10
Case ERROR_NO_ANSWER: temp = MsgBox(MSG11, vbExclamation, ProgTitle)
Call RecoreErr(MSG11)
StatusBar1.Panels(1).Text = MSG11
Case ERROR_NO_CARRIER: temp = MsgBox(MSG12, vbExclamation, ProgTitle)
Call RecoreErr(MSG12)
StatusBar1.Panels(1).Text = MSG12
Case ERROR_NO_DIALTONE: temp = MsgBox(MSG13, vbExclamation, ProgTitle)
Call RecoreErr(MSG13)
StatusBar1.Panels(1).Text = MSG13
Case ERROR_AUTHENTICATION_FAILURE: temp = MsgBox(MSG14, vbExclamation, ProgTitle)
Call RecoreErr(MSG14)
StatusBar1.Panels(1).Text = MSG14
Case ERROR_PPP_TIMEOUT: temp = MsgBox(MSG15, vbExclamation, ProgTitle)
Call RecoreErr(MSG15)
StatusBar1.Panels(1).Text = MSG15
Case 692: temp = MsgBox(MSG16, vbExclamation, ProgTitle)
Call RecoreErr(MSG16)
StatusBar1.Panels(1).Text = MSG16
Case 0 '成功
Command1.Enabled = False
Command2.Enabled = True
StatusBar1.Panels(1).Text = "状态:拨号成功!"
StartTime = Now
StatusBar1.Panels(3).Text = StartTime
If ViaModem Then
StatusBar1.Panels(2).Text = "调制解调器"
ElseIf ViaLAN Then
StatusBar1.Panels(2).Text = "局域网"
Else
StatusBar1.Panels(2).Text = "未知方式"
End If
'最好暂停一会在到托盘
StatusBar1.Panels(1).Text = "状态:在线!"
Sleep (1500)
'WindowState = vbMinimized
Set SysTray = New CSysTray
Set SysTray.SourceWindow = Me
SysTray.ChangeIcon App.Path & "\globe.ani"
SysTray.ToolTip = Me.Caption
SysTray.MinToSysTray
mnuTrayClose.Enabled = True
If Check2.Value = 1 Then
'If Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialStar", "Isdefault", "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialStar", "Isdefault", ""))) - 1) = "1" Then
hyperjump = ShellExecute(0&, vbNullString, "http://www.china-huahang.com/main.shtml", vbNullString, vbNullString, vbNormalFocus)
Else
hyperjump = ShellExecute(0&, vbNullString, Text8, vbNullString, vbNullString, vbNormalFocus)
End If
'是否启动流量计
'If Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialOther", "DialMmter", "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialOther", "DialMmter", ""))) - 1) = "1" Then
If Check3.Value = 1 Then
If FileExists(IIf(Right(App.Path, 1) = "\", App.Path & "DialMeter.exe", App.Path & "\DialMeter.exe")) = False Then
MsgBox "网速流量计文件不存在!", vbCritical, ProgTitle
Exit Sub
End If
Dim RetVal
RetVal = Shell(IIf(Right(App.Path, 1) = "\", App.Path & "DialMeter.exe", App.Path & "\DialMeter.exe"), 1)
End If
Case Else
End Select
End Sub
'关于
Private Sub Command4_Click()
MsgBox "拨号上网管理器 v1.10" & Chr(13) & "(c) 作者:马相赋 2002-2005" & Chr(13) & "因为公司没装宽带网，因为上网费用的问题，因为上网难管理．．．，所有的这些理由是促使我开发这个小软件的原因，虽然他可能对于全国到处宽度的今天已无用处，但对于我的公司可能起到一定的作用。这已足够，我终于找到一个还算可以的答案．", , "关于拨号管理器 v1.0"
End Sub
'修改密码
Private Sub Command7_Click()
If Trim(Text1) <> DeCrypt(Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPass" & Trim(Str(List1.ListIndex)), "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPass" & Trim(Str(List1.ListIndex)), ""))) - 1), "Mndsoft") Then
MsgBox "这好像不是您的密码哎,仔细想想!", vbCritical, ProgTitle
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Text1.SetFocus
Exit Sub
End If
Skin1.ApplySkin frmEditPassWord.hwnd
frmEditPassWord.Show vbModal
End Sub
'断开
Private Sub Command2_Click()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -