Bogart SysPwd.vb

Module syspwd

    Public Const STR_MASK = "MyFunction"            '加密用字串
    Public Const INT_PWD_LENGTH = 10                '預定義密碼長度
    Public GintCheckPwd As Integer
    '當傳入的密碼長度大於預定義密碼長度時
    '將?生一個Message Box
    '以下兩個常量是該Message Box中的具體提示資訊和標題欄中的文字
    Public Const STR_PWD_ERROR = "The length of password can not be greater than 10 characters !"
    Public Const STR_SYSTEM_NAME = "Bogart Report System"

    Public Const STR_INVALID_USER = "Password is not valid !"
    Public Const STR_CHANGE_PASSWORD_ERROR = "User ID is not valid !"

    '以下的變數的定義在正式使用時去掉

    '該函數的作用是將傳入的密碼字串轉換成加密的密碼字串
    '傳入的字串是用戶輸入的未經過系統加密的密碼
    '傳出的資料類型是字串型，?經過系統加密後的密碼

    Public Function EnPwd(ByVal strIn As String) As String
        Dim intCount As Integer
        Dim intPwdWord() As Integer
        Dim intTemp As Integer
        Dim strColumn1 As String
        Dim strColumn2 As String
        Dim strColumn3 As String
        Dim strTemp As String
        Dim intDivTemp As Integer

        strColumn1 = ""
        strColumn2 = ""
        strColumn3 = ""
        intTemp = 0
        strTemp = ""
        intDivTemp = 0

        If Len(strIn) > INT_PWD_LENGTH Then
            MsgBox(STR_PWD_ERROR, , STR_SYSTEM_NAME)
            EnPwd = ""
            Exit Function
        End If
        ReDim intPwdWord(INT_PWD_LENGTH)

        For intCount = 1 To INT_PWD_LENGTH
            If Len(STR_MASK) < INT_PWD_LENGTH Then
                intTemp = intTemp + 1
                If intTemp > Len(STR_MASK) Then
                    intTemp = 1
                End If
                intPwdWord(intCount) = Asc(Mid(STR_MASK, intTemp, 1))
            Else
                intPwdWord(intCount) = Asc(Mid(STR_MASK, intCount, 1))
            End If
        Next
        For intCount = 1 To Len(strIn)
            intTemp = Asc(Mid(strIn, intCount, 1))
            intDivTemp = intDivTemp + 1
            If intDivTemp > 5 Then
                intDivTemp = 1
            End If
            intTemp = intTemp * intDivTemp
            intPwdWord(intCount) = intPwdWord(intCount) + intTemp
        Next
        For intCount = 1 To INT_PWD_LENGTH
            strTemp = CStr(intPwdWord(intCount))
            If Len(strTemp) < 3 Then
                strTemp = StrDup(3 - Len(strTemp), "0") & strTemp
            End If
            strColumn1 = strColumn1 & Mid(strTemp, 1, 1)
            strColumn2 = strColumn2 & Mid(strTemp, 2, 1)
            strColumn3 = strColumn3 & Mid(strTemp, 3, 1)
        Next
        EnPwd = strColumn1 & strColumn2 & strColumn3

    End Function

    '該函數的作用是將傳入的加密的密碼字串轉換成不加密的密碼字串
    '傳入的字串是經過系統加密後的密碼
    '傳出的資料類型是字串型，?未經過系統加密的密碼

    Public Function DePwd(ByVal strIn As String) As String
        Dim intCount As Integer
        Dim intTemp As Integer
        Dim strTemp As String
        Dim strColumn1 As String
        Dim strColumn2 As String
        Dim strColumn3 As String
        Dim intPwdWord() As Integer
        Dim intDivTemp As Integer

        DePwd = ""
        strColumn1 = ""
        strColumn2 = ""
        strColumn3 = ""
        intTemp = 0
        strTemp = ""
        intDivTemp = 0

        strColumn1 = Mid(strIn, 1, INT_PWD_LENGTH)
        strColumn2 = Mid(strIn, INT_PWD_LENGTH + 1, INT_PWD_LENGTH)
        strColumn3 = Mid(strIn, INT_PWD_LENGTH * 2 + 1, INT_PWD_LENGTH)
        strTemp = ""
        For intCount = 1 To INT_PWD_LENGTH
            strTemp = strTemp & Mid(strColumn1, intCount, 1)
            strTemp = strTemp & Mid(strColumn2, intCount, 1)
            strTemp = strTemp & Mid(strColumn3, intCount, 1)
        Next
        ReDim intPwdWord(INT_PWD_LENGTH)
        For intCount = 1 To INT_PWD_LENGTH

            intPwdWord(intCount) = Val(Mid(strTemp, intCount * 3 - 2, 3))
            If Len(STR_MASK) < INT_PWD_LENGTH Then
                intTemp = intTemp + 1
                If intTemp > Len(STR_MASK) Then
                    intTemp = 1
                End If
                intPwdWord(intCount) = intPwdWord(intCount) - Asc(Mid(STR_MASK, intTemp, 1))
            Else
                intPwdWord(intCount) = intPwdWord(intCount) - Asc(Mid(STR_MASK, intCount, 1))
            End If
            intDivTemp = intDivTemp + 1
            If intDivTemp > 5 Then
                intDivTemp = 1
            End If
            intPwdWord(intCount) = intPwdWord(intCount) / intDivTemp
            If intPwdWord(intCount) <> 0 Then
                DePwd = DePwd & Chr(intPwdWord(intCount))

            End If
        Next

    End Function

    '以下函數?檢查密碼是否有效
    '傳入的第一個參數?用戶名，第二個是密碼（未加密）
    '如果密碼正確，則返回True
    '如果密碼不正確或該用戶不存在，則出現MsgBox後返回False
    Public Function CheckPwd(ByVal strUser As String, ByVal strPassword As String) As Boolean
        GintCheckPwd = GintCheckPwd + 1
        Dim Rs As New ADODB.Recordset
        Dim strSQLStmt As String

        CheckPwd = False
        On Error GoTo DBError
        If adoConn.State <> ConnectionState.Open Then
            adoConn.Open()
        End If

        strSQLStmt = "SELECT Password FROM " & g.gRptdev & "g_userid WHERE UserID='" & strUser & "'"

        '以下的dbconn應該改寫成統一的連庫
        Rs.Open(strSQLStmt, adoConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
        If Rs.Fields(0).Value <> EnPwd(strPassword.ToUpper) Then
            MsgBox(STR_INVALID_USER, vbCritical, STR_SYSTEM_NAME)
            'If GintCheckPwd = 3 Then
            '    MsgBox("您已經三次登陸失敗,系統將退出", vbExclamation, STR_SYSTEM_NAME)
            'End If
            Exit Function
        End If

        CheckPwd = True

        Exit Function
DBError:
        MsgBox(STR_INVALID_USER, vbExclamation, STR_SYSTEM_NAME)
    End Function

    '以下函數?檢查密碼是否有效
    '傳入的第一個參數?用戶名，第二個是新密碼（未加密）
    '如果更改成功，則返回True
    '如果更改不成功（可能因?用戶不存在等原因），則出現MsgBox後返回False
    Public Function ChangePwd(ByVal strUser As String, ByVal strPassword As String) As Boolean
        Dim Rs As ADODB.Recordset
        Dim strSQLStmt As String

        ChangePwd = False
        On Error GoTo DBError
        adoConn.BeginTrans()
        strSQLStmt = "SELECT Password FROM " & g.gRptdev & "g_userid WHERE UserID='" & strUser & "'"

        '以下的dbconn應該改寫成統一的連庫
        Rs = adoConn.Execute(strSQLStmt)
        If Rs.EOF Then
            MsgBox(STR_CHANGE_PASSWORD_ERROR, , STR_SYSTEM_NAME)
            Rs.Close()
            adoConn.RollbackTrans()
            Exit Function
        End If
        Rs.Close()
        strSQLStmt = "UPDATE " & g.gRptdev & "g_userid SET Password = '" & EnPwd(strPassword.ToUpper) & "' WHERE UserID='" & strUser & "'"

        adoConn.Execute(strSQLStmt)
        adoConn.CommitTrans()
        ChangePwd = True
        Exit Function
DBError:
        MsgBox(STR_CHANGE_PASSWORD_ERROR, , STR_SYSTEM_NAME)
        adoConn.RollbackTrans()
    End Function
End Module