clscryptoapi.cls

程序加密算法

      ConvertStringToHex = strOutput
  End If
    
' ---------------------------------------------------------------------------
' Empty variables
' ---------------------------------------------------------------------------
  strOutput = String$(250, 0)
    
End Function

Public Function CreateHash(Optional ByVal strInText As String = "", _
                Optional ByVal intHashChoice As Integer = 1, _
                Optional ByVal blnConvertToHex As Boolean = True, _
                Optional ByVal blnAppendPassword As Boolean = False, _
                Optional ByVal blnCaseSensitive As Boolean = False) As String
Attribute CreateHash.VB_Description = "Generate a one-way hash string from a string of data. Hash types are:  1=MD5  2=MD4  3=MD2  4=SHA"

' ***************************************************************************
' Routine:       CreateHash
'
' Description:   Generate a one-way hash string from a string of data. There
'                are 4 algorithms available in this version:
'                 1=MD5  2=MD4  3=MD2  4=SHA-1
'
'                Hashes are extremely useful for determining whether a
'                transmission or file has been altered.  The MDn returns a
'                16 character hash and the SHA-1 returns a 20 character hash.
'                No two hashes are alike unless the string matches perfectly,
'                whether binary data or a text string.  I use hashes to
'                create crypto keys and to verify integrity of packets when
'                using winsock (UDP especially). Be aware that if you choose
'                to not convert the return data to hex, then hashes may not
'                store to text correctly because of the possible existence of
'                non printable characters in the stream.
'
' Parameters:    strInText - string of data to be hashed.
'                intHashChoice - (Optional) Numeric identifier for the type
'                     of hash algorithm.  [Default] value = 1 (MD5)
'                blnConvertToHex - (Optional) [Default] TRUE=Convert return
'                     data to Hex format.
'                     FALSE=Do not convert the return data
'                blnAppendPassword - (Optional) [Default] FALSE=Do not append
'                     the password to the data to be hashed.
'                     True - Append the default password to data to be hashed.
'                blnCaseSensitive - (Optional) Only used if blnConvertToHex=TRUE
'                     [Default] FALSE=Convert return data to uppercase.
'                     TRUE=Return data as it was created.
'
' Returns:       ASCII string of characters
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 01-DEC-2000  Kevin Matthew Goss
'              Wrote routine
' 15-DEC-2000  Kenneth Ives  [e-mail]
'              Modified and documented
' 24-JUL-2001  Kenneth Ives  [e-mail]
'              Modified parameters and building password
' 09-SEP-2001  Kenneth Ives  [e-mail]
'              Documented and modified password creation
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngHashType      As Long
  Dim lngHashHwd       As Long
  Dim lngRetCode       As Long
  Dim lngIndex         As Long
  Dim lngOutputLength  As Long
  Dim strOutput        As String
  Dim strTempHash      As String
  Dim strPassword      As String
  Dim abytPWord()      As Byte
  
' ---------------------------------------------------------------------------
' Aquire the provider handle
' ---------------------------------------------------------------------------
  If m_lngCryptContext = 0 Then
      If Not GetProvider Then
          Call Class_Terminate       ' Failed.  Time to leave.
          Exit Function
      End If
  End If

' ---------------------------------------------------------------------------
' Append password to data to be hashed
' ---------------------------------------------------------------------------
  If blnAppendPassword Then
      ' see if we are holding a password
      If UBound(m_abytPWord) > 0 Then
          strPassword = ByteArrayToString(m_abytPWord()) ' convert password to string
      Else
          ' safety net in case the array is empty
          abytPWord = GetPassword(m_blnUseDefaultPWD)    ' create a random password
          strPassword = ByteArrayToString(abytPWord())   ' convert password to string
          Erase abytPWord()                              ' empty array
          ReDim abytPWord(0)                             ' resize to smallest size
      End If
      
      strInText = strInText & strPassword                ' append password
  End If
  
' ---------------------------------------------------------------------------
' Determine type of hash algorithm to use
' ---------------------------------------------------------------------------
  lngHashType = GetHashType(intHashChoice, lngOutputLength)
  
' ---------------------------------------------------------------------------
' The CryptCreateHash function initiates the hashing of a stream of data. It
' creates and returns to the calling application a handle to a CSP hash
' object. This handle is used in subsequent calls to CryptHashData to hash
' session keys and other streams of data.
' ---------------------------------------------------------------------------
  If Not CBool(CryptCreateHash(m_lngCryptContext, lngHashType, ByVal 0&, _
               ByVal 0&, lngHashHwd)) Then
      CreateHash = ""
      Exit Function
  End If

' ---------------------------------------------------------------------------
' The CryptHashData function adds data to a specified hash object. This
' function can be called multiple times to compute the hash of long or
' discontinuous data streams.
' ---------------------------------------------------------------------------
  If Not CBool(CryptHashData(lngHashHwd, strInText, Len(strInText), ByVal 0&)) Then
      CreateHash = ""
      Exit Function
  End If

' ---------------------------------------------------------------------------
' Initialize variables.  Do not use String$() to create your spaces.  Some
' API functions read each character as a single entity versus Space$() as
' a whole entity.  I do not recommend using NULL values.  Some API functions
' look at this as a null terminated string buffer and not a preloaded buffer.
' ---------------------------------------------------------------------------
  strTempHash = Space$(lngOutputLength)

' ---------------------------------------------------------------------------
' The CryptGetHashParam function retrieves data that governs the operations
' of a hash object. The actual hash value can be retrieved by using this
' function.
' ---------------------------------------------------------------------------
  If Not CBool(CryptGetHashParam(lngHashHwd, HP_HASHVAL, _
               strTempHash, lngOutputLength, ByVal 0&)) Then
      CreateHash = ""
      Exit Function
  End If
      
' ---------------------------------------------------------------------------
' See if we are to return the data in Hex or Binary format
' ---------------------------------------------------------------------------
  If blnConvertToHex Then
      ' convert to hex format
      If blnCaseSensitive Then
          strOutput = ConvertStringToHex(strTempHash, False) ' leave as is
      Else
          strOutput = ConvertStringToHex(strTempHash, True)  ' Uppercase [Default]
      End If
  Else
      ' Return the raw data in binary format
      strOutput = strTempHash
  End If
  
' ---------------------------------------------------------------------------
' Return hash data
' ---------------------------------------------------------------------------
  CreateHash = RTrim$(strOutput)
  
' ---------------------------------------------------------------------------
' Destroy hash object
' ---------------------------------------------------------------------------
  If lngHashHwd <> 0 Then
      lngRetCode = CryptDestroyHash(lngHashHwd)
  End If
  
' ---------------------------------------------------------------------------
' Empty variables
' ---------------------------------------------------------------------------
  strOutput = String$(250, 0)
  strPassword = String$(250, 0)
  strTempHash = String$(250, 0)
  
End Function

Public Function CreateRandom(Optional lngDataLength As Long = 40, _
                      Optional blnRetExactLength As Boolean = True, _
                      Optional blnConvertToHex As Boolean = False) As String
Attribute CreateRandom.VB_Description = "Get truly cryptographic strength random data.  Tested with DieHard and ENT tests for randomness."

' ***************************************************************************
' Routine:       CreateRandom
'
' Description:   Get truly cryptographic strength random data.  Tested with
'                DieHard and ENT tests for randomness.
'
' Parameters:    lngDataLength - (Optional) Length of data to be returned
'                                [Default] data length is 40 bytes
'                blnRetExactLength - (Optional) [Default] TRUE=Return just
'                      the length requested.
'                      FALSE=Return all generated data regardless of length.
'                blnConvertToHex - (Optional) [Default] FALSE=Do not convert
'                      the return data to hex format.
'                      TRUE=Convert return data to hex format.
'
' Returns:       A string of random data
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 01-DEC-2000  Kevin Matthew Goss
'              Routine created
' 03-OCT-2000  Kenneth Ives  [e-mail]
'              Modified and documented
' 24-JUL-2001  Kenneth Ives  [e-mail]
'              Reversed boolean parameters.  Added additional seed values.
' 09-SEP-2001  Kenneth Ives  [e-mail]
'              Documented and modified adding additional seeding.
' ***************************************************************************
    
' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim strOutput     As String
  Dim strRndBuffer  As String
  
' ---------------------------------------------------------------------------
' Initialize variables.
' ---------------------------------------------------------------------------
  strRndBuffer = ""
  strOutput = ""
  
' ---------------------------------------------------------------------------
' Aquire the provider handle
' ---------------------------------------------------------------------------
  If m_lngCryptContext = 0 Then
      If Not GetProvider Then
          Call Class_Terminate       ' Failed.  Time to leave.
          Exit Function
      End If
  End If
  
' ---------------------------------------------------------------------------
' The strRndBuffer must be at least the length of Data Length requested.
' This buffer is also where we can add additional seed values.  Build the
' additional seed values for the random generator.
' ---------------------------------------------------------------------------
  strRndBuffer = CStr(GetTickCount() + CDbl(Now()))  ' System time (2 ways)
  strRndBuffer = strRndBuffer & CreateSaltValue(40)  ' append 40 random chars
  strRndBuffer = CreateHash(strRndBuffer, 4, False)  ' hash using SHA-1
  
' ---------------------------------------------------------------------------
' Now we have an additional seed for the random number generator.  Be sure to
' append additional space for the return data.  Excess will be removed.
' ---------------------------------------------------------------------------
  strRndBuffer = strRndBuffer & Space$(lngDataLength)

' ---------------------------------------------------------------------------
' Create the random data
' ---------------------------------------------------------------------------
  If Not CBool(CryptGenRandom(m_lngCryptContext, lngDataLength, strRndBuffer)) Then
      CreateRandom = ""
      Exit Function
  End If
  
' ---------------------------------------------------------------------------
' Remove any trailing blank spaces
' ---------------------------------------------------------------------------
  strRndBuffer = RTrim$(strRndBuffer)

' ---------------------------------------------------------------------------
' Return the random data string
' ---------------------------------------------------------------------------
  If blnConvertToHex Then
      ' convert data string to hex
      strOutput = ConvertStringToHex(strRndBuffer, True)  'Uppercase [Default]
  Else
      ' do not convert to hex prior to returning the data string