登陆

Option Explicit

Dim miCount As Integer

Private Sub cmbShenFen_Change()

End Sub

Private Sub cmdCancel_Click()
  Call cancelConnection
  Unload Me
End Sub

Private Sub cmdOK_Click()
 
  '定义变量
  Dim txtSQL As String
  Dim mrc As ADODB.Recordset
  Dim MsgText As String

  txtUserName.text = "xxdlj"
  txtPassword.text = "xxdlj"
  cmbShenFen.text = "超级用户"

 
 
 
  '只允许6次的重登陆
  miCount = miCount + 1
  If miCount = 6 Then
        Unload Me
        Exit Sub
  End If
 
 
 
 
  '全程变量
  gstrShenFen = ""
 
  '若用户名为空
  If Trim(txtUserName.text) = "" Then
       MsgBox "用户名不能为空，请重新输入！", vbOKOnly + vbExclamation, "警告"
       txtUserName.SetFocus
       Exit Sub
  End If
  '否则设定SQL语句
  txtSQL = "select * from yonghuguanli where yonghuming= " & "'" & txtUserName.text & "'"
     '查询（用公共函数ExecuteSQL）
  Set mrc = ExecuteSQL(txtSQL, MsgText)
     '若无此用户
  If mrc.EOF = True Then
     MsgBox "用户名不正确，请重新输入！", vbOKOnly + vbExclamation
     txtUserName.SetFocus
     Exit Sub
  End If
  
  '密码不正确
  If mrc.Fields("mima") <> Trim(txtPassword.text) Then
         MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation
         txtPassword.text = ""
         txtPassword.SetFocus
        Exit Sub
  End If
 
 
  If mrc.Fields("shenfen") <> Trim(cmbShenFen) Then
     MsgBox "当前用户与身份不符，请确认！", vbOKOnly + vbExclamation
     cmbShenFen.SetFocus
     Exit Sub
  End If
      
      
  If LoginSpatialServer = False Then Exit Sub
      
  gstrShenFen = Trim(cmbShenFen)
  gstrYongHuMing = txtUserName
  Set mrc = Nothing
      
 
 
  SaveSetting "献县地理信息系统", "LoginInfo", "IpAddr", Trim(txtIP)
  SaveSetting "献县地理信息系统", "LoginInfo", "UserName", Trim(txtUser)
  SaveSetting "献县地理信息系统", "LoginInfo", "Password", Trim(txtPwd)
          
  Unload Me
 
  '进入系统
  frmPeiWang.Show
        
 
End Sub

Private Sub cmdXuanXiang_Click()
  Me.height = 4900
  cmdXuanXiang.Enabled = False
End Sub

Private Sub Form_Load()
 
  
  
   Me.height = 4200
  
   miCount = 0
   cmbShenFen.ListIndex = 0
   txtIP.text = GetSetting("献县地理信息系统", "LoginInfo", "IpAddr")
   txtUser.text = GetSetting("献县地理信息系统", "LoginInfo", "UserName")
   txtPwd.text = GetSetting("献县地理信息系统", "LoginInfo", "Password")
   Show
  
  
  
  
   
  
  
End Sub

Private Function LoginSpatialServer() As Boolean
   Dim addr As Long
   Dim ServerName As String
   Dim ServerDir As String
   Dim i As Integer
  
   LoginSpatialServer = True
  
   
   addr = inet_addr(Trim(txtIP.text))
   If addr = 0 Then
      MsgBox "IP地址不正确！", vbExclamation
       LoginSpatialServer = False
      Exit Function
   End If
  
  
   ServerName = GetHostByAddress(addr)
   If Len(ServerName) = 0 Then
       MsgBox "服务器不可达！", vbExclamation
       LoginSpatialServer = False
      Exit Function
   End If
  
  
 
   gstrShareDir = "\\" + Trim(ServerName) + "\" + Trim(txtDir.text)
  
   If addConnection(Trim(txtPwd), Trim(txtUser), gstrShareDir) = False Then
      
       i = InStr(ServerName, "~")
       If i = 0 Then
          MsgBox "服务器名称错误！"
          LoginSpatialServer = False
          Exit Function
       End If
       ServerName = Mid(ServerName, i + 1)
       gstrShareDir = "\\" + Trim(ServerName) + "\XXGIS"
      
       If addConnection(Trim(txtPwd), Trim(txtUser), gstrShareDir) = False Then
          MsgBox "连接空间数据库错误！", vbCritical
          LoginSpatialServer = False
       End If
   End If
End Function

Private Sub Image1_Click()

End Sub

Private Sub Label2_Click()

End Sub

Private Sub txtUserName_Change()

End Sub