clscryptoapi.cls

使用VB写的加密算法库

' Return the string data
' ---------------------------------------------------------------------------
  strOutput = RTrim$(strOutput)  ' remove trailing blanks
  ByteArrayToString = strOutput  ' return data string
  
' ---------------------------------------------------------------------------
' Empty variables
' ---------------------------------------------------------------------------
  strOutput = String$(250, 0)
  
End Function

Public Function ConvertByteToHex(ByRef abytData() As Byte) As String
Attribute ConvertByteToHex.VB_Description = "Convert byte array data to two character hex format and return in a single string."
   
' ***************************************************************************
' Routine:       ConvertByteFromHex
'
' Description:   Convert byte array data to two character hex format and
'                return in a single string.
'
' Parameters:    abytData() - An array of data to be converted
'
' Returns:       data string
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 20-JAN-2001  VB2-The-Max   http://www.vb2themax.com/
'              From an article titled "10 Hot Tips from VB-2-the-Max"
'              by Francesco Balena
'              This is tip no.9 on faster string concatenation with a little
'              modification.
' 05-JUN-2001  Kenneth Ives  [e-mail]
'              Modified and documented
' 24-JUL-2001  Kenneth Ives  [e-mail]
'              Modified and added documentation
' ***************************************************************************
    
' ---------------------------------------------------------------------------
' Define variables
' ---------------------------------------------------------------------------
  Dim strOutput        As String
  Dim intTemp          As Integer
  Dim lngLoop          As Long
  Dim lngMax           As Long
  Dim lngIndexPointer  As Long
  Dim lngPaddingLen    As Long
  
  Const ADD_SPACES     As Long = 10000
   
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  lngIndexPointer = 1                 ' start in first position of output string
  lngMax = UBound(abytData)           ' number of elements in array
  lngPaddingLen = (ADD_SPACES * 9)    ' 90,000 blank spaces
  strOutput = Space$(lngPaddingLen)   ' preload output string with blank spaces
  
' ---------------------------------------------------------------------------
' First, verify byte array has data in it.
' ---------------------------------------------------------------------------
  If lngMax > 0 Then
  
      ' Loop thru and convert the data
      For lngLoop = 0 To lngMax - 1
      
          ' see if some more padding has to be added to the output string
          If ((lngLoop * 2) + 2) >= lngPaddingLen Then
              lngPaddingLen = lngPaddingLen + ADD_SPACES ' boost blank space counter
              strOutput = strOutput & Space$(ADD_SPACES) ' append some blank spaces
          End If
          
          intTemp = CInt(abytData(lngLoop))              ' capture one byte
          
          ' replace 2 blank spaces with a hex value
          Mid$(strOutput, lngIndexPointer, 2) = Right$("00" & Hex$(intTemp), 2)
          
          lngIndexPointer = lngIndexPointer + 2   ' increment position pointer
      Next
      
      strOutput = RTrim$(strOutput)               ' remove trailing blanks
  Else
      strOutput = ""
  End If

' ---------------------------------------------------------------------------
' Return results
' ---------------------------------------------------------------------------
  ConvertByteToHex = strOutput
  
' ---------------------------------------------------------------------------
' Empty variables
' ---------------------------------------------------------------------------
  strOutput = String$(250, 0)
 
End Function

Public Function ConvertStringFromHex(ByVal strHex As String) As String
Attribute ConvertStringFromHex.VB_Description = "Convert hex data to ASCII decimal string format."

' ***************************************************************************
' Routine:       ConvertStringFromHex
'
' Description:   Convert hex data to ASCII decimal string format.
'
' Parameters:    strHex - Data to be converted
'
' Returns:       data string in ASCII decimal format
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 15-DEC-2000  Kenneth Ives  [e-mail]
'              Modified and documented
' 20-JAN-2001  VB2-The-Max   http://www.vb2themax.com/
'              From an article titled "10 Hot Tips from VB-2-the-Max"
'              by Francesco Balena
'              This is tip no.9 on faster string concatenation with a little
'              modification.
' 24-JUL-2001  Kenneth Ives  [e-mail]
'              Modified and added documentation
' ***************************************************************************
    
' ---------------------------------------------------------------------------
' Define variables
' ---------------------------------------------------------------------------
  Dim lngMax           As Long
  Dim lngLoop          As Long
  Dim lngLength        As Long
  Dim lngPaddingLen    As Long
  Dim lngIndexPointer  As Long
  Dim strTemp          As String
  Dim strOutput        As String
  
  Const ADD_SPACES     As Long = 10000

' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  strTemp = ""
  lngIndexPointer = 1                 ' index pointer for output string
  lngMax = Len(strHex)                ' length of input hex string
  lngPaddingLen = (ADD_SPACES * 9)    ' 90000 blank spaces
  strOutput = Space$(lngPaddingLen)   ' preload output string
  
' ---------------------------------------------------------------------------
' See if the hex data string can be divided evenly by two.  If not, then the
' data is corrupted.
' ---------------------------------------------------------------------------
  If lngMax Mod 2 <> 0 Then
      MsgBox "Data string is corrupted.  Cannot be Decrypted.", _
             vbCritical Or vbOKOnly, "Data corrupted"
      Exit Function
  End If
        
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  For lngLoop = 1 To lngMax Step 2
  
      strTemp = Chr$(Val("&H" & Mid$(strHex, lngLoop, 2)))
      lngLength = Len(strTemp)        ' save the length of the converted data
      
      ' see if some more padding has to be added to the output string
      If (lngIndexPointer + lngLength) >= lngPaddingLen Then
          lngPaddingLen = lngPaddingLen + ADD_SPACES  ' boost blank space counter
          strOutput = strOutput & Space$(ADD_SPACES)  ' append some blank spaces
      End If
      
      ' insert data into output string
      Mid$(strOutput, lngIndexPointer, lngLength) = strTemp
      
      ' increment output string pointer
      lngIndexPointer = lngIndexPointer + lngLength
             
  Next
    
' ---------------------------------------------------------------------------
' Return the formatted data
' ---------------------------------------------------------------------------
  strOutput = RTrim$(strOutput)     ' remove trailing blanks
  ConvertStringFromHex = strOutput  ' return data string
  
' ---------------------------------------------------------------------------
' Empty variables
' ---------------------------------------------------------------------------
  strOutput = String$(250, 0)

End Function

Public Function ConvertStringToHex(ByVal strInput As String, _
                       Optional blnRetUppercase As Boolean = True) As String
Attribute ConvertStringToHex.VB_Description = "Take one character at a time and convert first to an integer then to hex."
    
' ***************************************************************************
' Routine:       ConvertStringToHex
'
' Description:   Take one character at a time and convert first to an
'                integer then to hex.  Prefix with two zeros in case the
'                result is 0x00 to 0x0F (leading zeros tend to disappear).
'                Then capture the last two characters.  This will give a
'                good two character hex display.
'
' Parameters:    blnRetUppercase - (Optional) [Default] - TRUE=Convert data
'                        to uppercase before leaving this routine.
'                        FALSE=Do not convert the data to uppercase.
'
' Returns:       hex data string in uppercase
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 15-DEC-2000  Kenneth Ives  [e-mail]
'              Modified and documented
' 20-JAN-2001  VB2-The-Max   http://www.vb2themax.com/
'              From an article titled "10 Hot Tips from VB-2-the-Max"
'              by Francesco Balena
'              This is tip no.9 on faster string concatenation with a little
'              modification.
' 24-JUL-2001  Kenneth Ives  [e-mail]
'              Modified and added documentation
' ***************************************************************************
    
' ---------------------------------------------------------------------------
' Define variables
' ---------------------------------------------------------------------------
  Dim lngMax           As Long
  Dim lngLoop          As Long
  Dim lngLength        As Long
  Dim lngPaddingLen    As Long
  Dim lngIndexPointer  As Long
  Dim strTemp          As String
  Dim strOutput        As String
  
  Const ADD_SPACES     As Long = 10000

' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  strTemp = ""
  lngIndexPointer = 1                 ' index pointer for output string
  lngMax = Len(strInput)              ' length of input data string
  lngPaddingLen = (ADD_SPACES * 9)    ' 90000 blank spaces
  strOutput = Space$(lngPaddingLen)   ' preload output string
  
' ---------------------------------------------------------------------------
' Convert to hex
' ---------------------------------------------------------------------------
  For lngLoop = 1 To lngMax
      
      strTemp = Right$("00" & Hex$(Asc(Mid$(strInput, lngLoop, 1))), 2)
      lngLength = Len(strTemp)        ' save the length of the converted data
      
      ' see if some more padding has to be added to the output string
      If (lngIndexPointer + lngLength) >= lngPaddingLen Then
          lngPaddingLen = lngPaddingLen + ADD_SPACES  ' boost blank space counter
          strOutput = strOutput & Space$(ADD_SPACES)  ' append some blank spaces
      End If
      
      ' insert data into output string
      Mid$(strOutput, lngIndexPointer, lngLength) = strTemp
      
      ' increment output string pointer
      lngIndexPointer = lngIndexPointer + lngLength
  Next
    
' ---------------------------------------------------------------------------
' remove trailing blanks
' ---------------------------------------------------------------------------
  strOutput = RTrim$(strOutput) ' remove trailing blanks
      
' ---------------------------------------------------------------------------
' Return hex string
' ---------------------------------------------------------------------------
  If blnRetUppercase Then
      ConvertStringToHex = StrConv(strOutput, vbUpperCase)
  Else