frmdialupmanage0308.frm

adsl拨号工具 有很多功能 不错啊 大家试试

Call RecoreWork
Dim Temp As Long
If List1.Text = "" Then
     MsgBox "我不知道您是谁，我不好记录您的操作哎,看用户列表中有没有您的大名!", vbCritical, ProgTitle
     List1.SetFocus
     Exit Sub
  End If
'校验密码
If Trim(Text1) <> selestr(QueryValue(hKey, SetKeyPropertyA, "WatchWord" & Trim(Str(List1.ListIndex)))) 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 LenB(Text2) < 6 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"
'DoEvents
'Shell "Rasphone.exe -d Adsl", vbNormalFocus
Dim RetVal
'RetVal = Shell(IIf(Right(App.Path, 1) = "\", App.Path & "dmDialer.exe", App.Path & "\dmDialer.exe"), 1)
' Shell "rundll rnaui.dll,RnaDial 163", vbNormalFocus

'SendKeys "~"
'DoEvents


    Dim nError As Integer
    rasDialer.PhoneNumber = "0"
    rasDialer.UserName = Trim(Text6.Text)
    rasDialer.Password = Trim(Text7.Text)
    rasDialer.UserDomain = ""
    nError = rasDialer.Connect()
    If nError <> 0 Then
       MsgBox "无法连接到" & rasDialer.PhoneEntry, vbExclamation, App.Title
       Exit Sub
    End If



'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 633: Temp = MsgBox(MSG16, vbExclamation, ProgTitle)
'             Call RecoreErr(MSG16)
'             StatusBar1.Panels(1).Text = MSG16
'             Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl,,add", vbNormalFocus
'        Case 623: Temp = MsgBox(MSG17, vbExclamation, ProgTitle)
'             Call RecoreErr(MSG17)
'             StatusBar1.Panels(1).Text = MSG17
'             If GetWinSysTmpPath(0) = "C:\WINDOWS" Then  'windows9x,me
'                Shell "rundll32.exe rnaui.dll,RnaWizard"
'             Else                                        'winnt,2000,xp
'             End If
'        Case 0   '成功
'             Command1.Enabled = False
'             Command2.Enabled = True
             StatusBar1.Panels(1).Text = "状态:拨号成功!"
             StartTime = Format(Now, "yyyy/mm/dd hh:mm:ss")
             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
               If Text8.Text <> "" Then
               hyperjump = ShellExecute(0&, vbNullString, Text8, vbNullString, vbNullString, vbNormalFocus)
               End If
             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
                RetVal = Shell(IIf(Right(App.Path, 1) = "\", App.Path & "DialMeter.exe", App.Path & "\DialMeter.exe"), 1)
             End If
'        Case Else
'             MsgBox Temp & "没有成功,重拨!", vbCritical
'             Exit Sub
'End Select

End Sub

'运行拨号属性
Private Sub Command11_Click()
'    Shell "C:\WINDOWS\rundll32.exe shell32.dll,Control_RunDLL modem.cpl,,add"
    
    Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl", vbNormalFocus
End Sub

'关于
Private Sub Command4_Click()
    ShellAbout hwnd, "拨号上网管理器 v1.0#(c)  作者:马相赋 2002-2005", "  适用于...", Icon
End Sub

'弹出
Private Sub Command6_Click()
    PopupMenu menutyskin
End Sub

'修改密码
Private Sub Command7_Click()
    If Trim(Text1) <> selestr(QueryValue(hKey, SetKeyPropertyA, "WatchWord" & Trim(Str(List1.ListIndex)))) 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()
  If IsConnected = True Then
     
    Dim nError As Integer
        StatusBar1.Panels(1).Text = "正在断开连接..."
        DoEvents
        nError = rasDialer.Disconnect()
        StatusBar1.Panels(1).Text = "已断开"
        WindowState = 0
    ' Call HangUp
    ' Call RemoveConnection(hconn)
     Call RecoreWork
     Command2.Enabled = False
     Text1 = ""
 End If
End Sub

'系统参数设置
Private Sub Command3_Click()
   If selestr(QueryValue(hKey, SetKeyPropertyA, "level" & Trim(Str(List1.ListIndex)))) <> "SuperManage" Then
      MsgBox "呵呵,您是没有超级管理权限的,要想获取此权限,那就向管理员申请吧!", vbCritical, ProgTitle
      Exit Sub
   Else
      If Trim(Text1) = "" Then
         MsgBox "虽然你是超级管理员也要输入密码哎!", vbCritical, ProgTitle
         Text1.SelStart = 0
         Text1.SelLength = Len(Text1.Text)
         Text1.SetFocus
         Exit Sub
      End If
      If Trim(Text1) <> selestr(QueryValue(hKey, SetKeyPropertyA, "WatchWord" & Trim(Str(List1.ListIndex)))) Then
         MsgBox "这好像不是您的密码哎,仔细想想!", vbCritical, ProgTitle
         Text1.SelStart = 0
         Text1.SelLength = Len(Text1.Text)
         Text1.SetFocus
         Exit Sub
      Else
         fromrs = True
         Me.Height = 7455
      End If
   End If
End Sub

Private Sub Command5_Click()
  Command2_Click
  Unload Me
  End
End Sub

'增加
Private Sub Command8_Click()
       '先检测数据有效性
       If Len(Text3) = 0 Then
          MsgBox "请输入需要拨号的用户大名!", vbCritical, ProgTitle
          Text3.SetFocus
          Exit Sub
       End If
       '密码
       If Len(Text4) = 0 Then
          MsgBox "您操作的拨号口令可要输入呦,别人用您的账号我可不管!", vbCritical, ProgTitle
          Text4.SetFocus
          Exit Sub
       End If
       If Len(Text5) = 0 Then
          MsgBox "为防止万一,您还是再确认一次口令吧!", vbCritical, ProgTitle
          Text5.SetFocus
          Exit Sub
       End If
       If Text4 <> Text5 Then
          MsgBox "哎,第一次咋和第二次密码不一样呢?", vbCritical, ProgTitle
          Text5.SetFocus
          Exit Sub
       End If
       
       'If GetSetting(App.EXEName, "IsSetting", "Yesno", "") = "1" Then
       If Val(QueryValue(hKey, "Software\Mndsoft", "IsSetting")) = 1 Then
          UserID = QueryValue(hKey, CreateKeyA, "DialUserTotal")
          Call SetKeyValue(hKey, SetKeyPropertyA, "UserName" & Trim(Str(UserID + 1)), Trim(Text3), REG_SZ)
          Call SetKeyValue(hKey, SetKeyPropertyA, "WatchWord" & Trim(Str(UserID + 1)), Trim(Text4), REG_SZ)
          Call SetKeyValue(hKey, SetKeyPropertyA, "Level" & Trim(Str(UserID + 1)), IIf(Check1.Value = 1, "SuperManage", "GeneralManage"), REG_SZ)
          Call SetKeyValue(hKey, CreateKeyA, "DialUserTotal", UserID + 1, REG_DWORD)
          List2.AddItem Text3 & "  " & IIf(Check1.Value = 1, "超级管理用户", "普通拨号用户")
          List1.AddItem Text3
          Text3 = ""
          Text4 = ""
          Text5 = ""
       Else
          '初次建立系统基础信息
          If Check1.Value <> 1 Then
             MsgBox "第一次建立用户可是必须为超级权限呦!", vbInformation, ProgTitle
             Check1.Value = 1
             Exit Sub
          End If
          Call CreateNewKey(hKey, "Software\Mndsoft")   '创建程序主键
          Call SetKeyValue(hKey, "Software\Mndsoft\", "IsSetting", 1, REG_DWORD)  '置标记为1
          Call SetKeyValue(hKey, "Software\Mndsoft\", "ProgramName", "DialManager" & App.Major & "." & App.Minor, REG_SZ)  '置程序名称
          Call CreateNewKey(hKey, CreateKeyA)        'Property
          Call CreateNewKey(hKey, SetKeyPropertyA)   '用户列表
          Call CreateNewKey(hKey, SetKeyPropertyB)   '拨号设置
          Call CreateNewKey(hKey, SetKeyPropertyC)   '其他
          '添加信息
          Call SetKeyValue(hKey, SetKeyPropertyA, "UserName0", Trim(Text3), REG_SZ)
          Call SetKeyValue(hKey, SetKeyPropertyA, "WatchWord0", Trim(Text4), REG_SZ)
          Call SetKeyValue(hKey, SetKeyPropertyA, "Level0", "SuperManage", REG_SZ)
          Call SetKeyValue(hKey, CreateKeyA, "DialUserTotal", 0, REG_DWORD)
          List2.AddItem Text3 & "  " & "超级管理用户"
          List1.AddItem Text3
          Text3 = ""
          Text4 = ""
          Text5 = ""
       End If
     
     
End Sub

'保存以上设置
Private Sub Command13_Click()
'禁止IE显示“工具”中“INTERNET选项” ????无效
'在HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer下
'在右边的窗口中新建一个二进制值“NoFolderOptions”，并设值为“01 00 00 00”。'
  
'禁止使用注册表编辑文件regedit.Exe
'　　　HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Policies\System
'　　　在右边的窗口中创建一个DOWRD值："DisableRegistryTools"，并将其值设为“1”。
  
'  禁止修改“控制面版”
'　　　在HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer下
'　　　在右边的窗口中新建一个二进制"NoSetFolders",并将其值设为"01 00 00 00"。
'禁止修改开始菜单
'　　　在HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer下
'　　　在右边的窗口中创建一个DOWRD值："NoChangeStartMenu",并将其值设为“1”。
'禁用“网络”控制面板
'　　　在HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Network\System
'　　　下，在右边的窗口中新建DWORD值“NoNetSetup”，并设其值为“1”。

'禁止使用reg文件
'　　　在HKEY_LOCAL_MACHINE\Software\CLASSES\.reg下
'　　　在右边的窗口中更改“默认”值为“txtfile”

'禁止使用“重置WEB设置”
'　　　在HKEY_CURRENT_USER\Software\Policies\Microsoft\Internet Explorer\Control Panel下
'　　　在右边的窗口中新建一个DWORD值“Connection Settings”，并设值为“1”。
'禁止使用IE“internet选项”中的高级项(winnt适用)
'　　　在HKEY_CURRENT_USER\Software\Policies\Microsoft\Internet Explorer\Control Panel下
'　　　在右边的窗口中新建一个DWORD值“AdvancedTab”，并设值为“1”。
'禁止出现IE菜单中“工具”栏里“interner选项”
'