mdllogin.bas

管理文档的原代码,可以把扫描的文档归类,便于查询

Attribute VB_Name = "MdlLogin"
Option Explicit

'######################################################################
'设置用户信息
'######################################################################
Public Function Set_User_Info(p_User_Info As User_Info, p_Rdo_Result As rdoResultset) As Boolean
On Error GoTo Err

If p_Rdo_Result.RowCount < 1 Then GoTo Err
With p_User_Info
   .Branch_ID = CInt(Convert_Value(p_Rdo_Result.rdoColumns("branch_id"), 0, p_Rdo_Result.rdoColumns("branch_id").Type, False, False))
   .Department_ID = CInt(Convert_Value(p_Rdo_Result.rdoColumns("Department_ID"), 0, p_Rdo_Result.rdoColumns("Department_ID").Type, False, False))
   .Level_ID = CInt(Convert_Value(p_Rdo_Result.rdoColumns("Level_ID"), 0, p_Rdo_Result.rdoColumns("Level_ID").Type, False, False))
   .Lock_Status = CInt(Convert_Value(p_Rdo_Result.rdoColumns("Lock_Status"), 0, p_Rdo_Result.rdoColumns("Lock_Status").Type, False, False))
   .Login_Name = Convert_Value(p_Rdo_Result.rdoColumns("Login_Name"), 0, p_Rdo_Result.rdoColumns("Login_Name").Type, False, False)
   .Password = Convert_Value(p_Rdo_Result.rdoColumns("Password"), 0, p_Rdo_Result.rdoColumns("Password").Type, False, False)
   .Retry_Time = CInt(Convert_Value(p_Rdo_Result.rdoColumns("Retry_Time"), 0, p_Rdo_Result.rdoColumns("Retry_Time").Type, False, False))
   .Expire_Time = CDate(Convert_Value(p_Rdo_Result.rdoColumns("expire_Time"), 0, p_Rdo_Result.rdoColumns("expire_Time").Type, False, False))
   .User_ID = CInt(Convert_Value(p_Rdo_Result.rdoColumns("User_ID"), 0, p_Rdo_Result.rdoColumns("User_ID").Type, False, False))
   .User_Name = Convert_Value(p_Rdo_Result.rdoColumns("User_Name"), 0, p_Rdo_Result.rdoColumns("User_Name").Type, False, False)
End With
Set_User_Info = True
Exit Function
Err:
   Set_User_Info = False
   Call Clear_User_Info(p_User_Info)
End Function

'######################################################################
'清除用户信息
'######################################################################
Public Sub Clear_User_Info(p_User_Info As User_Info)
With p_User_Info
   .Branch_ID = 0
   .Department_ID = 0
   .Level_ID = 0
   .Lock_Status = 0
   .Login_Name = ""
   .Password = ""
   .Retry_Time = 0
   .User_ID = 0
   .User_Name = ""
   .Expire_Time = Date
End With
End Sub

'######################################################################
'用户退录函数LogOut
'参数：p_Login_Name退录用户名 p_User_ID 退录用户ID
'返回值：Boolean
'######################################################################
Public Function LogOut(p_Login_Name As String, p_User_ID As Integer) As Boolean
On Error GoTo Err
If p_User_ID <> 0 Then
   Set GblRdoRes = GblRdoCon.OpenResultset("update user_table set retry_time=0,lock_status=0 where user_id=" + CStr(p_User_ID), rdOpenDynamic, rdConcurRowVer)
ElseIf p_Login_Name <> "" Then
   Set GblRdoRes = GblRdoCon.OpenResultset("update user_table set retry_time=0,lock_status=0 where login_name='" + p_Login_Name + "'", rdOpenDynamic, rdConcurRowVer)
Else
   GoTo Err
End If
LogOut = True
Exit Function
Err:
   LogOut = False
End Function

'######################################################################
'用户登录函数Login
'参数：p_Login_Name登录用户名 p_PWD登录用户密码
'返回值：p_Rtn_String返回描述 p_User_Info返回用户结构
'函数返回：1 登录成功 非1登录失败 2  操作员被锁定   3   口令不正确
'4  3次不正确，锁定   5  操作员不存在 6 系统无操作员 7操作员正在使用中 8操作员过期
'######################################################################
Public Function Login(p_Login_Name As String, p_PWD As String, _
                p_Rtn_String As String, p_User_Info As User_Info) As Integer

On Error GoTo Err
Dim t_Rtn_Code As Integer '函数返回值

p_Rtn_String = ""
Call Clear_User_Info(p_User_Info)

Set GblRdoRes = GblRdoCon.OpenResultset("select * from user_table ", rdOpenDynamic, rdConcurRowVer)
If GblRdoRes.RowCount < 1 Then
   p_Rtn_String = "您输入的操作员代号不存在，请重新输入"
   Login = 6 '没有操作员
   GoTo Err
End If

Set GblRdoRes = GblRdoCon.OpenResultset("select * from user_table where login_name='" + Trim(p_Login_Name) + "'", rdOpenDynamic, rdConcurRowVer)

'操作员代号不存在
If GblRdoRes.RowCount < 1 Then
   p_Rtn_String = "您输入的操作员代号不存在，请重新输入"
   Login = 5
   GoTo Err
End If

Call Set_User_Info(p_User_Info, GblRdoRes)

With p_User_Info
    
    '操作员被锁定
    If .Lock_Status = 1 Then
       p_Rtn_String = "本操作员已经被锁定，暂时无法使用"
       Login = 4
       GoTo Err
    End If
    
    If .Expire_Time < Date Then
       p_Rtn_String = "本操作员代号已经过期，无法使用"
       Login = 8
       GoTo Err
    End If
    
    '口令不正确
    If Des(Trim(p_PWD), CLng(.User_ID), 1) <> GblRdoRes.rdoColumns("password") Then
       If .Retry_Time >= 2 Then '口令输入3次不正确，操作员被锁定
          p_Rtn_String = "口令输入3次不正确，操作员被锁定"
          Login = 4
          GblRdoCon.Execute "update user_table set lock_status=1,retry_time=3 where user_id=" + CStr(.User_ID)
       Else
          p_Rtn_String = "您输入的口令不正确，请重新输入"
          Login = 3
          GblRdoCon.Execute "update user_table set retry_time=retry_time+1 where user_id=" + CStr(.User_ID)
       End If
       GoTo Err
    End If
    
    '操作员正在使用，可以不验证
'    If .Lock_Status = 2 Then
'       p_Rtn_String = "本操作员已经登录到系统中，您暂时无法使用"
'       Login = 7
'       GoTo Err
'    End If

    GblRdoCon.Execute "update user_table set lock_status=2,Retry_time=0 where user_id=" + CStr(.User_ID)
    Login = 1 '成功登录
End With

Exit Function
Err:
   If Login = 0 Then p_Rtn_String = "用户登录时出错，请与管理员联系"
End Function

'######################################################################
'用户操作权限认证函数
'参数：p_User_ID须认证的用户ID p_Operate_Code 认证的操作代码
'函数返回：Boolean 是否通过
'######################################################################
Public Function Check_Operate_Permission(p_User_ID As String, p_Operate_Code As String) As Boolean
On Error GoTo Err
Dim tSql As String
'Set GblRdoRes = GblRdoCon.OpenResultset("select Check_Operate_Permission(2,'1001')", rdOpenDynamic, rdConcurRowVer)
'If GblRdoRes.EOF Then GoTo Err
'If GblRdoRes.rdoColumns(1) = 0 Then GoTo Err
tSql = "select distinct(role_right.operate_code) from user_role,role_right " & _
       "where user_role.role_id = role_right.role_id and " & _
       "user_role.user_id=" + p_User_ID + " and role_right.operate_code='" + p_Operate_Code + "'"
Set GblRdoRes = GblRdoCon.OpenResultset(tSql, rdOpenDynamic, rdConcurRowVer)
If GblRdoRes.EOF Then GoTo Err
Check_Operate_Permission = True
Exit Function
Err:
   Check_Operate_Permission = False
End Function

'######################################################################
'文件访问权限认证函数
'参数：p_User_Info须认证的用户结构 p_File_ID 认证的文件ID p_Type_Code认证的文件档案类型
'函数返回：boolean
'         r_rights 0无权限 1查看 2打印 3无文件
'         若此参数初始值为1或2时函数验证是否有相应权限，返回值为boolean 否则函数返回具有的最高权限r_rights
'         r_Effective_Time 生效时间 r_Expire_Time 失效时间 可以为空
'         p_Query_Date 查询的日期
'######################################################################
Public Function Check_File_Permission(p_User_Info As User_Info, p_File_ID As String, p_Type_Code As String, _
       p_Query_Date As Date, r_Effective_Time As String, r_Expire_Time As String, r_Rights As Integer) As Boolean
On Error GoTo Err

Dim t_Rights As Integer '当前的最高权限 0无权限 1查看 2打印 3无文件
Dim tSql As String
Dim tSql1, tSql2, tSql3 As String

Dim a(3, 2) As String


r_Effective_Time = ""
r_Expire_Time = ""
Check_File_Permission = False

'查看文件默认权限
t_Rights = Check_File_Default_Permission(p_User_Info, p_File_ID, p_Type_Code)
If IsDate(p_Query_Date) = False Then GoTo Err

If t_Rights = 2 Then '已经具有最高权限
   Check_File_Permission = True
   r_Rights = 2
   Exit Function
ElseIf t_Rights = 3 Then '没有此文件
   Check_File_Permission = False
   r_Rights = 0
   Exit Function
End If
   
If r_Rights <> 0 Then '检查是否具有所传参数的权限
   tSql2 = " and rights>=" + CStr(r_Rights) + " "
   tSql3 = " and a.rights>=" + CStr(r_Rights) + " "
Else '检查最高权限
   tSql2 = " "
   tSql3 = " "
End If

'时间期限条件子句
tSql1 = "to_date('" + Format(p_Query_Date, "yyyy-mm-dd") + "','yyyy-mm-dd')"
tSql1 = " and effective_time is null or (effective_time<" + tSql1 + " and (expire_time>" + tSql1 + " or expire_time is null) "

'检查部门
tSql = "select * from file_right where type_code='" + p_Type_Code + "' and " & _
       "file_id=" + p_File_ID + " and type=2 and object_id=" + CStr(p_User_Info.Department_ID) & _
       tSql1 + tSql2 + " order by rights desc"
Set GblRdoRes = GblRdoCon.OpenResultset(tSql, rdOpenDynamic, rdConcurRowVer)
If Not GblRdoRes.EOF Then
   t_Rights = GblRdoRes.rdoColumns("rights")
   If r_Rights <> 0 And t_Rights >= r_Rights Then '检查是否具有所传参数的权限
      r_Rights = t_Rights
      Check_File_Permission = True
      If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
      If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      Exit Function
   ElseIf r_Rights = 0 Then '检查最高权限
      If r_Rights < t_Rights Then
         r_Rights = t_Rights
         If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
         If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      End If
   End If
End If

'检查用户
tSql = "select * from file_right where type_code='" + p_Type_Code + "' and " & _
       "file_id=" + p_File_ID + " and type=0 and object_id=" + CStr(p_User_Info.User_ID) & _
       tSql1 + tSql2 + " order by rights desc"
Set GblRdoRes = GblRdoCon.OpenResultset(tSql, rdOpenDynamic, rdConcurRowVer)
If Not GblRdoRes.EOF Then
   t_Rights = GblRdoRes.rdoColumns("rights")
   If r_Rights <> 0 And t_Rights >= r_Rights Then '检查是否具有所传参数的权限
      r_Rights = t_Rights
      Check_File_Permission = True
      If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
      If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      Exit Function
   ElseIf r_Rights = 0 Then '检查最高权限
      If r_Rights < t_Rights Then
         If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
         If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      End If
   End If
End If

'检查级别
tSql = "select * from file_right where type_code='" + p_Type_Code + "' and " & _
       "file_id=" + p_File_ID + " and type=3 and object_id=" + CStr(p_User_Info.Level_ID) & _
       tSql1 + tSql2 + " order by rights desc"
Set GblRdoRes = GblRdoCon.OpenResultset(tSql, rdOpenDynamic, rdConcurRowVer)
If Not GblRdoRes.EOF Then
   t_Rights = GblRdoRes.rdoColumns("rights")
   If r_Rights <> 0 And t_Rights >= r_Rights Then '检查是否具有所传参数的权限
      r_Rights = t_Rights
      Check_File_Permission = True
      If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
      If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      Exit Function
   ElseIf r_Rights = 0 Then '检查最高权限
      If r_Rights < t_Rights Then
         If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
         If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      End If
   End If
End If

'时间期限条件子句
tSql1 = "to_date('" + Format(p_Query_Date, "yyyy-mm-dd") + "','yyyy-mm-dd')"
tSql1 = " and a.effective_time is null or (a.effective_time<" + tSql1 + " and (a.expire_time>" + tSql1 + " or a.expire_time is null) "

'检查角色
tSql = "select a.rights,a.effective_time,a.expire_time from file_right a," & _
     "(select  distinct(role_id) as role_id from user_role where user_id=" + CStr(p_User_Info.User_ID) + ")  b " & _
     "where a.object_id=b.role_id and a.type=1 " + tSql1 + tSql3 + " order by a.rights desc"
Set GblRdoRes = GblRdoCon.OpenResultset(tSql, rdOpenDynamic, rdConcurRowVer)
If Not GblRdoRes.EOF Then
   t_Rights = GblRdoRes.rdoColumns("rights")
   If r_Rights <> 0 And t_Rights >= r_Rights Then '检查是否具有所传参数的权限
      r_Rights = t_Rights
      Check_File_Permission = True
      If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
      If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      Exit Function
   ElseIf r_Rights = 0 Then '检查最高权限
      If r_Rights < t_Rights Then
         If IsDate(GblRdoRes.rdoColumns("effective_time")) Then r_Effective_Time = Format(GblRdoRes.rdoColumns("effective_time"), "yyyy-mm-dd")
         If IsDate(GblRdoRes.rdoColumns("expire_time")) Then r_Expire_Time = Format(GblRdoRes.rdoColumns("expire_time"), "yyyy-mm-dd")
      End If
   End If
End If

If r_Rights = 0 Then
   Check_File_Permission = False
Else
   Check_File_Permission = True
End If
Exit Function

Err:
   Check_File_Permission = False
End Function

'######################################################################
'文件访问默认权限认证函数
'参数：p_User_Info须认证的用户结构 p_File_ID 认证的文件ID p_Type_Code认证的文件档案类型
'函数返回：0无权限 1查看 2打印 3无文件
'######################################################################
Public Function Check_File_Default_Permission(p_User_Info As User_Info, _
                p_File_ID As String, p_Type_Code As String) As Integer
On Error GoTo Err

Dim tSql As String

tSql = "select * from file_" + p_Type_Code + " where file_id=" + p_File_ID
Set GblRdoRes = GblRdoCon.OpenResultset(tSql, rdOpenDynamic, rdConcurRowVer)
If GblRdoRes.EOF Then
   Check_File_Default_Permission = 3
   Exit Function
End If

With p_User_Info
      
Select Case UCase(p_Type_Code)
 Case "WENSHU"
   '分行行级可阅可打印
   If .Branch_ID = 1001 And .Level_ID < 1001 Then   '分行行级
      Check_File_Default_Permission = 2
      Exit Function
   End If
   
   '主办部门处级可阅可打印
   If .Department_ID = GblRdoRes.rdoColumns("department_id") And _
      .Branch_ID = GblRdoRes.rdoColumns("branch_id") And .Level_ID < "2001" Then
      Check_File_Default_Permission = 2
      Exit Function
   End If