frmdialupmanageold.frm

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

  Call RemoveConnection(hconn)
  Call RecoreWork
  Command2.Enabled = False
End Sub

'系统参数设置
Private Sub Command3_Click()
   If DeCrypt(Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialLevel" & Trim(Str(List1.ListIndex)), "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialLevel" & Trim(Str(List1.ListIndex)), ""))) - 1), "Mndsoft") <> "SuperManage" Then
      MsgBox "呵呵,您是没有超级管理权限的,要想获取此权限,那就向管理员申请吧1", 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) <> 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
      Else
         fromrs = True
         Me.Height = 7455
      End If
   End If
End Sub

Private Sub Command5_Click()
  Unload Me
  End
End Sub

'增加
Private Sub Command8_Click()
    If FileExists(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini")) Then
       UserID = ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserCount", "DialUserID", "")
       '用户名
       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
       Else
          List2.AddItem Text2 & "  " & IIf(Check1.Value = 1, "超级管理用户", "普通拨号用户")
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialUser" & Trim(Str(Val(UserID + 1))), Trim(Text3.Text))
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPass" & Trim(Str(Val(UserID + 1))), Crypt(Trim(Text4.Text), "Mndsoft"))
          '重复密码
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPassR" & Trim(Str(Val(UserID + 1))), Crypt(Trim(Text5.Text), "Mndsoft"))
          '用户计数
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserCount", "DialUserID", Trim(Str(Val(UserID + 1))))
          '权限
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialLevel" & Trim(Str(Val(UserID + 1))), IIf(Check1.Value = 1, Crypt("SuperManage", "Mndsoft"), Crypt("GeneralManage", "Mndsoft")))
          List1.AddItem Text3
          Text3 = ""
          Text4 = ""
          Text5 = ""
       End If
    Else
       '用户名
       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
          Text4.SetFocus
          Exit Sub
       End If
       If Text4 <> Text5 Then
          MsgBox "哎,第一次咋和第二次密码不一样呢?", vbCritical, ProgTitle
          Text5.SetFocus
          Exit Sub
       Else  '初次进入
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserCount", "DialUserID", 0)
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialUser0", Trim(Text3.Text))
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPass0", Crypt(Trim(Text4.Text), "Mndsoft"))
          Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialPassR0", Crypt(Trim(Text5.Text), "Mndsoft"))
          '权限
          If Check1.Value <> 1 Then
             MsgBox "第一次建立用户可是必须为超级权限呦!", vbInformation, ProgTitle
             Check1.Value = 1
             Exit Sub
          Else
             Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialLevel0", Crypt("SuperManage", "Mndsoft"))
          End If
          List2.AddItem Text2 & "  " & IIf(Check1.Value = 1, "超级管理用户", "普通拨号用户")
          List1.AddItem Text2
          Check1.Value = 0
          Text3 = ""
          Text4 = ""
          Text5 = ""
       End If
    End If
End Sub

'保存以上设置
Private Sub Command13_Click()
  If Combo1.Text = "" Then
     MsgBox "同志,拨号上网的类型还没有设置呀!", vbCritical, ProgTitle
     Combo1.SetFocus
     Exit Sub
  End If
  If Text6 = "" Then
     MsgBox "看看,又把上网的用户账号忘了吧!", vbCritical, ProgTitle
     Text5.SetFocus
     Exit Sub
  End If
  If Text7 = "" Then
     MsgBox "还是把密码也输入吧,免得等会浪费时间,一分一秒皆是钱啊!:-)", vbCritical, ProgTitle
     Text6.SetFocus
     Exit Sub
  End If
  '类型
  Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialType", Trim(Combo1.Text))
  '用户名
  Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialName", Trim(Text6.Text))
  '密码
  Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialPassWord", Crypt(Trim(Text7.Text), "Mndsoft"))
  '是否默认
  Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialStar", "Isdefault", Check2.Value)
  '进入地址
  Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialStar", "UrlAddress", Text8.Text)
  '保存其他参数
  Call WriteINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialOther", "DialMmter", Check3.Value)
  
  fromrs = False
  Me.Height = 3345
End Sub

Private Sub Form_Load()
  DoEvents
  Me.Height = 3545
  Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
  If App.PrevInstance Then
     MsgBox ("程序已经运行，不能再次装载！"), vbExclamation, "警告！"
     Unload Me
     End
  End If
  If FileExists(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini")) Then
     Dim i As Integer
     '若有ini则加载其中参数
     '加载用户名
     UserID = ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserCount", "DialUserID", "")
     For i = 0 To UserID
         List1.AddItem ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialUser" & Trim(Str(i)), "")
         List2.AddItem conv_str(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialUser" & Trim(Str(i)), "")) _
                       & "  " & IIf(DeCrypt(conv_str(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialUserList", "DialLevel" & Trim(Str(i)), "")), "Mndsoft") = "SuperManage", "超级管理员", "普通管理员")
     Next
     '加载拨号参数
     Combo1 = Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialType", "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialType", ""))) - 1)
     Text6 = Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialName", "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialName", ""))) - 1)
     Text7 = DeCrypt(Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialPassWord", "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialInfo", "DialPassWord", ""))) - 1), "Mndsoft")
     '加载运行项目
     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
        Text8 = "http://www.china-huahang.com/main.shtml"
        Check2.Value = 1
        Text8.Enabled = False
     Else
        Text8 = Left(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialStar", "UrlAddress", "")), Len(Trim(ReadINI(IIf(Right(App.Path, 1) = "\", App.Path & "DialSetup.ini", App.Path & "\DialSetup.ini"), "DialStar", "UrlAddress", ""))) - 1)
        Text8.Enabled = True
        Check2.Value = 0
     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
        Check3.Value = 1
     Else
        Check3.Value = 0
     End If
  Else
     MsgBox "在使用本系统之前,请进行增加用户或其他参数设置！", vbInformation, ProgTitle
     fromrs = True
     Me.Height = 7455
  End If
  Command1.Enabled = False
  Command2.Enabled = False
  Command3.Enabled = False
  Command7.Enabled = False
  Combo1.AddItem "163"
  Combo1.AddItem "169"
  Combo1.ListIndex = 0
  If FileExists(IIf(Right(App.Path, 1) = "\", App.Path & "RecordDialList.Txt", App.Path & "\RecordDialList.Txt")) = False Then
     Open IIf(Right(App.Path, 1) = "\", App.Path & "RecordDialList.Txt", App.Path & "\RecordDialList.Txt") For Append As #1
     Print #1, "拨号上网管理器记录列表 起始于:" & Now
     Print #1, "======================================================"
     Print #1, "是谁上网   上网类型     工作内容                       开始时间               结束时间            上网状态"
     Print #1, "-------------------------------------------------------------------------------------------------------------"
     Close #1
  End If
  If FileExists(IIf(Right(App.Path, 1) = "\", App.Path & "RecordError.Txt", App.Path & "\RecordError.Txt")) = False Then
     Open IIf(Right(App.Path, 1) = "\", App.Path & "RecordError.Txt", App.Path & "\RecordError.Txt") For Append As #1
     Print #1, "拨号上网管理器错误记录列表 起始于:" & Now
     Print #1, "======================================================"
     Print #1, "是谁上网   上网类型     工作内容                       时间            上网状态"
     Print #1, "--------------------------------------------------------------------------------"
     Close #1
  End If
  Skin1.LoadSkin App.Path & "\Skins\winaqua.skn"
  Skin1.ApplySkin Me.hwnd
  If IsConnected Then
     mnuTrayClose.Enabled = True
     StatusBar1.Panels(1).Text = "状态:已在线!"
     If ViaModem Then
        StatusBar1.Panels(2).Text = "调制解调器"
     ElseIf ViaLAN Then
        StatusBar1.Panels(2).Text = "局域网"
     Else
        StatusBar1.Panels(2).Text = "未知方式"
     End If
  Else
     mnuTrayClose.Enabled = False
     StatusBar1.Panels(1).Text = "状态:未在线!"
  End If
  
  'Call DisableX(Me)
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  If fromrs Then
     Me.Height = 7905
     Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
  Else
     Me.Height = 3360
     Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
  End If
  Me.Width = 6585
  If WindowState = vbMinimized Then
     Me.Hide
     AddToTray Me, mnuTray
     SetTrayTip "拨号上网管理器 v1.0"
     mnuTrayRestore.Enabled = True
  End If
  If WindowState <> vbMinimized Then LastState = WindowState
  On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If IsConnected = True Then
      Call RemoveConnection(hconn)
      Call RecoreWork
  End If
  RemoveFromTray
End Sub

Private Sub List1_Click()
    If List1.SelCount > 0 Then
       Command3.Enabled = True
     End If
     Text1.SetFocus
End Sub

'菜单关闭断线
Private Sub mnuTrayClose_Click()
    Call Command2_Click
End Sub

'菜单恢复窗口
Private Sub mnuTrayRestore_Click()
    Me.WindowState = vbNormal
    Me.Show
    App.TaskVisible = True
    RemoveFromTray
End Sub

Private Sub Text1_Change()
   If Len(Trim(Text1)) <> 0 Then
      Command7.Enabled = True
   Else
      Command7.Enabled = False
   End If
End Sub

Private Sub Text2_Change()
   If Len(Trim(Text2)) <> 0 Then
      Command1.Enabled = True
   Else
      Command1.Enabled = False
   End If
End Sub

'检测是否局域网
Private Function ViaLAN() As Boolean
    Dim SFlags As Long
    '返回连接的标识
    Call InternetGetConnectedState(SFlags, 0&)
    '如返回True则是局域网
    ViaLAN = SFlags And INTERNET_CONNECTION_LAN
End Function

'监测是否modem
Private Function ViaModem() As Boolean
    Dim SFlags As Long
    '返回连接的标识
    Call InternetGetConnectedState(SFlags, 0&)
    '如返回True则是调制解调器
    ViaModem = SFlags And INTERNET_CONNECTION_MODEM
End Function

'保存上网信息
Sub RecoreWork()
    On Error Resume Next
    Open IIf(Right(App.Path, 1) = "\", App.Path & "RecordDialList.Txt", App.Path & "\RecordDialList.Txt") For Append As #1
    Print #1, List1.Text & "       " & Combo1.Text & "        " & Trim(Text2.Text) & "             " & StartTime & "     " & IIf(Len(EndTime) = 0, Now, EndTime) & "  成功!"
    Close #1
End Sub

'保存拨号不成功信息
Sub RecoreErr(ErrInfo As String)
    On Error Resume Next
    Open IIf(Right(App.Path, 1) = "\", App.Path & "RecordError.Txt", App.Path & "\RecordError.Txt") For Append As #1
    Print #1, List1.Text & "       " & Combo1.Text & "        " & Trim(Text2.Text) & "                      " & IIf(Len(EndTime) = 0, Now, EndTime) & "  " & ErrInfo
    Close #1
End Sub