basadodb.bas

程序加密算法

'                blnAddQuery - (Optional) TRUE/FALSE
'                              [Default] FALSE - We are NOT adding a new user
'                                     and if we find them in the database, we
'                                     want to return the salt and hashed values
'                              TRUE - We are adding a new user and only want
'                                     to return a TRUE or FALSE on whether or
'                                     not the user already exists.
'
' Returns:       strSalt and strHash values if user is in the database and
'                this is not an AddNew query.  Also, return a TRUE/FALSE based
'                on the findings.
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-DEC-2000  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRecCount   As Long
  Dim strTmpUserID  As String
  Dim strUserID     As String
  Dim strSQL        As String
  Dim cCrypto       As CryptKci.clsCryptoAPI
  
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  strSalt = ""
  strHash = ""
  Set cCrypto = New CryptKci.clsCryptoAPI
  
' ---------------------------------------------------------------------------
' Convert User ID from byte array to string
' ---------------------------------------------------------------------------
  strTmpUserID = cCrypto.ByteArrayToString(arUserID())

' ---------------------------------------------------------------------------
' Build the hashed user ID by using whatever hash algorithm was selected.
' ---------------------------------------------------------------------------
  strUserID = cCrypto.CreateHash(strTmpUserID, g_intHashType, True, , True)

' ---------------------------------------------------------------------------
' Build SQL statement
' ---------------------------------------------------------------------------
  strSQL = "SELECT * FROM [PWord] Where [UserID] = '" & strUserID & "'"
                   
  On Error GoTo Query_User_Error
' ---------------------------------------------------------------------------
' Open the password database to validate the UserID
' ---------------------------------------------------------------------------
  Open_connPWD
  
' ---------------------------------------------------------------------------
' Get the data
' ---------------------------------------------------------------------------
  Set rsPWord = New ADODB.Recordset
  rsPWord.Open strSQL, connPWD, adOpenStatic, adLockOptimistic, adCmdText
  lngRecCount = rsPWord.RecordCount  ' save the record count
  
' ---------------------------------------------------------------------------
' see if the User ID is on file
' ---------------------------------------------------------------------------
  If lngRecCount < 1 Then
      Query_User = False
  Else
      If Not blnAddQuery Then
          ' Captaure the Salt and Hashed results
          ' to future comparisons
          strSalt = rsPWord!Salt
          strHash = rsPWord!Result
      End If
      
      Query_User = True
  End If
  
CleanUp:
  rsPWord.Close       ' close the recordset
  connPWD.Close       ' close the database
  
Normal_Exit:
' ---------------------------------------------------------------------------
' free objects form memory
' ---------------------------------------------------------------------------
  Set rsPWord = Nothing
  Set connPWD = Nothing
  Set cCrypto = Nothing
  Exit Function


Query_User_Error:
' ---------------------------------------------------------------------------
' Display an error message
' ---------------------------------------------------------------------------
  MsgBox "Error:  " & CStr(Err.Number) & " " & Err.Description & vbLf & _
         "User [ " & strTmpUserID & " ] was not found.", _
         vbExclamation Or vbOKOnly, "Querying Database"
  Query_User = False
  Resume Normal_Exit

End Function

Public Function Remove_User(arUserID() As Byte) As Boolean

' ***************************************************************************
' Routine:       Remove_User
'
' Description:   Query the password database searching for a hashed user ID.
'                The user ID is passed here in a byte array and then
'                converted to string.  The string is then hashed using
'                whatever hash algorithm was selected.  The database is then
'                read.  If the user is found, the record is deleted.
'
' Parameters:    arUserID() - byte array containing the user ID
'
' Returns:       TRUE/FALSE based on the findings
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-DEC-2000  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRecCount   As Long
  Dim strTmpUserID  As String
  Dim strUserID     As String
  Dim strSQL        As String
  Dim cCrypto       As CryptKci.clsCryptoAPI
  
' ---------------------------------------------------------------------------
' Convert User ID from byte array to string
' ---------------------------------------------------------------------------
  Set cCrypto = New CryptKci.clsCryptoAPI
  strTmpUserID = cCrypto.ByteArrayToString(arUserID())

' ---------------------------------------------------------------------------
' Build the hashed user ID by using whatever hash algorithm was selected.
' ---------------------------------------------------------------------------
  strUserID = cCrypto.CreateHash(strTmpUserID, g_intHashType, True, , True)

' ---------------------------------------------------------------------------
' build SQL statement
' ---------------------------------------------------------------------------
  strSQL = "SELECT * FROM [PWord] Where [UserID] = '" & strUserID & "'"
                           
  On Error GoTo Remove_User_Error
' ---------------------------------------------------------------------------
' Open the password database to validate the UserID
' ---------------------------------------------------------------------------
  Open_connPWD
  
' ---------------------------------------------------------------------------
' Get the data
' ---------------------------------------------------------------------------
  Set rsPWord = New ADODB.Recordset
  rsPWord.Open strSQL, connPWD, adOpenStatic, adLockOptimistic, adCmdText
  
' ---------------------------------------------------------------------------
' Remove this record from the database
' ---------------------------------------------------------------------------
  rsPWord.Delete
  rsPWord.Requery
  Remove_User = True

CleanUp:
  rsPWord.Close       ' close the recordset
  connPWD.Close       ' close the database
  
Normal_Exit:
' ---------------------------------------------------------------------------
' free objects form memory
' ---------------------------------------------------------------------------
  Set rsPWord = Nothing
  Set connPWD = Nothing
  Set cCrypto = Nothing
  Exit Function

Remove_User_Error:
' ---------------------------------------------------------------------------
' Display an error message
' ---------------------------------------------------------------------------
  MsgBox "Error:  " & CStr(Err.Number) & " " & Err.Description & vbLf & _
         "User [ " & strTmpUserID & _
         " ] was not removed.", _
         vbExclamation Or vbOKOnly, "Delete a user ID"
  Remove_User = False
  Resume Normal_Exit

End Function

Public Function Update_User(arUserID() As Byte, arPWord() As Byte) As Boolean

' ***************************************************************************
' Routine:       Update_User  (Password changes)
'
' Description:   The user ID and the user supplied password is passed here
'                in a byte array and then converted to strings.  A unique
'                salt value is generated.  The user ID string is then hashed
'                using whatever hash algorithm was selected.  The password
'                and the salt value are concatenated and also hashed.  This
'                becomes the hashed results.  The salt value and hashed
'                results are then added to the database.  The date timestamp
'                is also added.
'
' Parameters:    arUserID() - byte array containing the user ID
'                arPWord() - byte array containing the user password
'
' Returns:       TRUE/FALSE based on the findings
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-DEC-2000  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRecCount   As Long
  Dim strTmpUserID  As String
  Dim strUserID     As String
  Dim strPWord      As String
  Dim strSalt       As String
  Dim strHash       As String
  Dim strSQL        As String
  Dim strTmp        As String
  Dim cCrypto       As CryptKci.clsCryptoAPI
  
' ---------------------------------------------------------------------------
' Convert User ID from byte array to string
' ---------------------------------------------------------------------------
  Set cCrypto = New CryptKci.clsCryptoAPI
  strTmpUserID = cCrypto.ByteArrayToString(arUserID())

' ---------------------------------------------------------------------------
' Convert password array to string data
' ---------------------------------------------------------------------------
  strPWord = cCrypto.ByteArrayToString(arPWord())
               
' ---------------------------------------------------------------------------
' Build the hashed user ID by using whatever hash algorithm was selected.
' ---------------------------------------------------------------------------
  strUserID = cCrypto.CreateHash(strTmpUserID, g_intHashType, True, , True)

' ---------------------------------------------------------------------------
' Create unique salt value 15 bytes long
' ---------------------------------------------------------------------------
  strSalt = cCrypto.CreateSaltValue(15)
  
' ---------------------------------------------------------------------------
' Build the hashed results by concatenating the user supplied password and
' the randomly generated salt value.  Use whatever hash algorithm was
' selected.
' ---------------------------------------------------------------------------
  strHash = cCrypto.CreateHash(strPWord & strSalt, g_intHashType, True, , True)

' ---------------------------------------------------------------------------
' build SQL statement
' ---------------------------------------------------------------------------
  strSQL = "SELECT * FROM [PWord] Where [UserID] = '" & strUserID & "'"
                           
  On Error GoTo Update_User_Error
' ---------------------------------------------------------------------------
' Open the password database to validate the UserID
' ---------------------------------------------------------------------------
  Open_connPWD
  
' ---------------------------------------------------------------------------
' Get the data
' ---------------------------------------------------------------------------
  Set rsPWord = New ADODB.Recordset
  rsPWord.Open strSQL, connPWD, adOpenStatic, adLockOptimistic, adCmdText
  
' ---------------------------------------------------------------------------
' Add the new user information to the database
' ---------------------------------------------------------------------------
  rsPWord!Salt = strSalt
  rsPWord!Result = strHash
  rsPWord!Timestamp = Now()
  rsPWord.Update
  Update_User = True

CleanUp:
  rsPWord.Close       ' close the recordset
  connPWD.Close       ' close the database
  
Normal_Exit:
' ---------------------------------------------------------------------------
' free objects form memory
' ---------------------------------------------------------------------------
  Set rsPWord = Nothing
  Set connPWD = Nothing
  Set cCrypto = Nothing
  Exit Function

Update_User_Error:
' ---------------------------------------------------------------------------
' Display an error message
' ---------------------------------------------------------------------------
  MsgBox "Error:  " & CStr(Err.Number) & " " & Err.Description & vbLf & _
         "User [ " & strTmpUserID & _
         " ] was not updated.", _
         vbExclamation Or vbOKOnly, "Updating Database"
  Update_User = False
  Resume Normal_Exit

End Function