Excel数据操作模块

Option Explicit

'获取字段数据通过字段名（字符型索引）
Public Function GetEncryptDataForStrField(ByVal tableName As String, _
    ByVal fieldname As String, _
    ByVal expfield As String, _
    ByVal e_str As String) As String
    Dim ret As String
    ret = GetDataForField(tableName, fieldname, expfield, e_str)
    GetEncryptDataForStrField = ret
    
End Function

'获取字段数据通过字段名（整型索引）
Public Function GetEncryptDataForIntField(ByVal tableName As String, _
    ByVal fieldname As String, _
    ByVal expfield As String, _
    ByVal e_int As Integer) As String
    Dim ret As String
    ret = GetDataForField(tableName, fieldname, expfield, e_int)
    GetEncryptDataForIntField = ret
    
End Function

'获取数据字段内容
Public Function GetDataForField1(ByVal tableName As String, _
                                    ByVal fieldname As String, _
                                    ByVal expfield As String, _
                                    ByVal expfieldvalue As String) As String
                                
    Dim conn As New ADODB.Connection
    Dim dbo As New DataOperate
    
    Set conn = dbo.GetConnExcel
    
    Dim Sql As String
    Sql = dbo.GetQuerySQLString(tableName, "a", "f", "*", expfield & "='" & expfieldvalue & "'")
    
    Dim rs As ADODB.Recordset
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    Dim ret As String
    
    With rs
        
        If Not rs.EOF Then
            ret = rs(fieldname).value
        End If
    
    End With
    
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    
    GetDataForField1 = ret
    
End Function
    
'获取数据字段内容
Public Function GetDataForField(ByVal tableName As String, _
                                ByVal fieldname As String, _
                                ByVal expfield As String, _
                                ByVal expfieldvalue As String) As String
    
    Dim rng As Range
    Dim col1, col2, row As Integer
    Set rng = ThisWorkbook.RngFind(fieldname, Sheets(tableName).Range("a1:z1"))
    If Not rng Is Nothing Then
        col1 = rng.Column
    Else
        Exit Function
    End If
    Set rng = ThisWorkbook.RngFind(expfield, Sheets(tableName).Range("a1:z1"))
    If Not rng Is Nothing Then
        col2 = rng.Column
    Else
        Exit Function
    End If
    Set rng = ThisWorkbook.RngFind(expfieldvalue, _
                Application.Range(Sheets(tableName).Cells(2, col2), _
                                    Sheets(tableName).Cells(100, col2)))
    If Not rng Is Nothing Then
        row = rng.row
    Else
        Exit Function
    End If
    
    Dim ret As String
    ret = Sheets(tableName).Cells(row, col1).value
    GetDataForField = ret
    
End Function
    
'设置数据字段内容
Public Function SetDataForField(ByVal tableName As String, _
                                ByVal fieldname As String, _
                                ByVal expfield As String, _
                                ByVal expfieldvalue As String, _
                                ByVal value As String) As Integer
    
    Dim rng As Range
    Dim col1, col2, row As Integer
    Set rng = ThisWorkbook.RngFind(fieldname, Sheets(tableName).Range("a1:z1"))
    If Not rng Is Nothing Then
        col1 = rng.Column
    Else
        SetDataForField = 0
        Exit Function
    End If
    Set rng = ThisWorkbook.RngFind(expfield, Sheets(tableName).Range("a1:z1"))
    If Not rng Is Nothing Then
        col2 = rng.Column
    Else
        SetDataForField = 0
        Exit Function
    End If
    Set rng = ThisWorkbook.RngFind(expfieldvalue, _
                Application.Range(Sheets(tableName).Cells(2, col2), _
                                    Sheets(tableName).Cells(100, col2)))
    If Not rng Is Nothing Then
        row = rng.row
    Else
        SetDataForField = 0
        Exit Function
    End If
    
    Sheets(tableName).Cells(row, col1).value = value
    SetDataForField = 1
    
End Function
    

'获取密码对照表
Public Function GetEncrptCharNumTableForUid(ByVal uId As Integer) As String()
    
    Dim s1, s2, s3, str As String
    s1 = GetEncryptDataForIntField("xtpass", "xhdzb1", "uid", uId)
    s2 = GetEncryptDataForIntField("xtpass", "xhdzb2", "uid", uId)
    s3 = GetEncryptDataForIntField("xtpass", "xhdzb3", "uid", uId)
    
    str = Trim(s1) & " " & Trim(s2) & " " & Trim(s3)
    str = Replace(str, "  ", " ")

    GetEncrptCharNumTableForUid = Split(str)
    
End Function

'获取密码对照表
Public Function GetEncrptCharNumStringForUid(ByVal uId As Integer) As String

    Dim s1, s2, s3, str As String
    s1 = GetEncryptDataForIntField("xtpass", "xhdzb1", "uid", uId)
    s2 = GetEncryptDataForIntField("xtpass", "xhdzb2", "uid", uId)
    s3 = GetEncryptDataForIntField("xtpass", "xhdzb3", "uid", uId)
    
    str = Trim(s1) & " " & Trim(s2) & " " & Trim(s3)
    str = Replace(str, "  ", " ")

    GetEncrptCharNumStringForUid = str

End Function

'获取密码对照表
Public Function GetEncrptCharNumTable(ByVal str As String) As String

    GetEncrptCharNumTable = Trim(Split(Mid(str, 2, Len(str) - 2), ",")(2))

End Function

'获取加密随机数
Public Function GetEncryptRndNumForUid(ByVal uId As Integer) As Integer

    Dim s_id As String
    s_id = GetEncryptDataForIntField("xtpass", "i_rnd", "uid", uId)
    
    If s_id = "" Then
        GetEncryptRndNumForUid = 0
    Else
        GetEncryptRndNumForUid = CInt(s_id)
    End If

End Function

'获取加密随机数
Public Function GetEncryptRndNum(ByVal str As String) As Integer

    GetEncryptRndNum = Split(Mid(str, 2, Len(str) - 2), ",")(0)

End Function


'获取加密或解密字符
Public Function GetEncryptStringForUid(ByVal uId As Integer) As String
    GetEncryptStringForUid = GetEncryptDataForIntField("userpass", "password", "uid", uId)
End Function


'获取加密或解密字符
Public Function GetEncryptString(ByVal str As String) As String

    GetEncryptString = Split(Mid(str, 2, Len(str) - 2), ",")(1)

End Function


'添加新用户记录
Public Function AddNewRecord(ByVal uName As String, _
            ByVal uId As Integer, _
            ByVal regdate As Date, _
            ByVal Privileges As String)

    Dim dbo As New DataOperate
    Dim conn As New ADODB.Connection
    Set conn = dbo.GetConnExcel
    
    Dim Sql As String
    Sql = dbo.GetQuerySQLString("userinf", "a", "f", "*", "")
    
    Dim rs As ADODB.Recordset
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    Dim ret As String
    
    With rs
    
        If Not rs.EOF Then .MoveFirst
        
        .AddNew
        
        !uId = uId
        !uName = uName
        !regdate = regdate
        !Privileges = Privileges
        
        .Update
        
    End With
    
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    
End Function

'获取最大用户ID
Public Function GetMaxIid() As Integer

    Dim dbo As New DataOperate
    Dim conn As New ADODB.Connection
    Set conn = dbo.GetConnExcel
    
    Dim Sql As String
    Sql = dbo.GetQuerySQLString("userinf", "a", "f", "*", "")
    
    Dim rs As ADODB.Recordset
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    Dim maxid As Integer
    maxid = 0
    
    With rs
    
        Do Until rs.EOF
            If rs("uid").value > maxid Then
maxid = rs("uid").value
            End If
            rs.MoveNext
        Loop
        
    End With
    
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    
    GetMaxIid = maxid
    
End Function

'获取更新用户密码
Public Function UpdataUPwd(ByVal uId As Integer, ByVal pwd As String)

    Dim dbo As New DataOperate
    Dim conn As New ADODB.Connection
    Set conn = dbo.GetConnExcel
    
    Dim Sql As String
    Sql = dbo.GetQuerySQLString("userpass", "a", "f", "*", "uid='" & uId & "'")
    
    Dim rs As ADODB.Recordset
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    With rs
        
        
        If Not rs.EOF Then
            
            !Password = pwd
            .Update
        
        End If
        
    End With
    
    'rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
        
End Function

'设置新用户密码档案
'pwdstr需要是三段字符串，含随机数、加密对照表、密码字符
Public Function AddNewUserPwd(ByVal uId As Integer, ByVal pwdstr As String)

    Dim dbo As New DataOperate
    Dim conn As New ADODB.Connection
    Set conn = dbo.GetConnExcel
    
    Dim Sql As String
    Sql = dbo.GetQuerySQLString("xtpass", "a", "f", "*", "")
    
    Dim rs As ADODB.Recordset
    
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    
    Dim a_xhb() As String
    
    a_xhb = Split(Mid(Split(pwdstr, ",")(2), 1, Len(Split(pwdstr, ",")(2)) - 1))
    Dim xhb1, xhb2, xhb3 As String
    
    xhb1 = ""
    xhb2 = ""
    xhb3 = ""
    
    Dim i_xhb As Integer
    i_xhb = Int(UBound(a_xhb) / 3)
    
    Dim i
    
    For i = 0 To UBound(a_xhb)
        If i < i_xhb Then
            xhb1 = xhb1 & a_xhb(i) & " "
        ElseIf i < i_xhb * 2 Then
            xhb2 = xhb2 & a_xhb(i) & " "
        Else
            xhb3 = xhb3 & a_xhb(i) & " "
        End If
        
    Next
   
    With rs

        '.MoveFirst
        .AddNew
        !uId = uId
        !i_rnd = UserAdmin.GetEncryptRndNum(pwdstr)
        
        !xhdzb1 = xhb1
        !xhdzb2 = xhb2
        !xhdzb3 = xhb3
        
        !mmsj = Date
        .Update

    End With

    Set rs = Nothing
    
    Sql = dbo.GetQuerySQLString("userpass", "a", "f", "*", "")
    
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    With rs
        
        .AddNew
        !uId = uId
        !Password = UserAdmin.GetEncryptString(pwdstr)
        !mmsj = Date
        .Update
    
    End With
    
    rs.Close
    Set rs = Nothing
    conn.Close
    
    Set conn = Nothing
        
End Function

'删除用户记录
Public Function DelUserRecord(ByVal uId As Integer)

    Dim dbo As New DataOperate
    Dim conn As New ADODB.Connection
    Set conn = dbo.GetConnExcel1
    
    Dim Sql As String
    Sql = dbo.GetQuerySQLString("userinf", "a", "f", "*", "uid='" & uId & "'")
    
    Dim rs As ADODB.Recordset
    Set rs = dbo.ExecuteQuery(conn, Sql)
    
    Dim ret As String
    
    With rs
    
        If rs.EOF Then Exit Function
        
        !uId = ""
        !uName = ""
        !regdate = ""
        !Privileges = ""
        
        .Update
        
    End With
    
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    
End Function

'删除用户记录
Public Function DelUserRecord2(ByVal uId As Integer)
        
    Dim c As Range
    
    With ThisWorkbook.Sheets("userinf").Range("a1:a500")
        
        Set c = .Find(uId, LookIn:=xlValues)
        If Not c Is Nothing Then
            
            ThisWorkbook.Sheets("userinf").Rows(c.row()).Delete
        
        End If
    End With

    With ThisWorkbook.Sheets("userpass").Range("a1:a500")
        
        Set c = .Find(uId, LookIn:=xlValues)
        If Not c Is Nothing Then
            
            ThisWorkbook.Sheets("userpass").Rows(c.row()).Delete
        
        End If
    End With

    With ThisWorkbook.Sheets("xtpass").Range("a1:a500")
        
        Set c = .Find(uId, LookIn:=xlValues)
        If Not c Is Nothing Then
            
            ThisWorkbook.Sheets("xtpass").Rows(c.row()).Delete
        
        End If
    End With

End Function

'获取用户Id通过用户名查找
Public Function FindUserIdForUName(ByVal uName As String) As String
    
    Dim s_uid As String
    s_uid = GetDataForField("userinf", "uid", "uname", uName)
    FindUserIdForUName = s_uid
    
End Function

'获取用户权限通过Id查找
Public Function GetUserPrivilegesForId(ByVal uId As Integer) As String
    
    Dim priv As String
    priv = GetDataForField("userinf", "Privileges", "uid", uId)
    GetUserPrivilegesForId = priv
    
End Function

'从一个表查查询字段数据
Public Function FindData(ByVal sheetName As String, ByVal fieldIndex As String) As String
    Dim r As Range
    With Sheets(sheetName).Range("b2:b500")
        Set r = .Find(fieldIndex, LookIn:=xlValues)
        If Not r Is Nothing Then
            FindData = Sheets(sheetName).Cells(r.row, 3).value
        End If
    End With
End Function