当前位置：首页 > news >正文

登陆

news 来源：原创 2024/5/5 0:35:41

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