mactripledes.cls

这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.

    
    If cArray.IsNull(InputBuffer) Then _
        Throw Cor.NewArgumentNullException("InputBuffer cannot be null", "InputBuffer")
    If InputOffset < LBound(InputBuffer) Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_LBound), "InputOffset", InputOffset)
    If (cArray.GetLength(InputBuffer) - InputCount < InputOffset) Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidCountOffset))

    Call StartHash
    
    Dim Ret() As Byte
    If InputCount > 0 Then
        Call mStream.WriteBlock(InputBuffer, InputOffset, InputCount)
        
        ReDim Ret(0 To InputCount - 1)
        Call CopyMemory(Ret(0), InputBuffer(InputOffset), InputCount)
    Else
        Ret = Cor.NewBytes
    End If
    
    Call EndHash
    TransformFinalBlock = Ret
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByRef RgbKey() As Byte, ByVal StrTripleDES As String)
    Set mTripleDES = CryptoConfig.CreateFromName(StrTripleDES)
    Call SetKey(RgbKey)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub SetKey(ByRef Key() As Byte)
    ' we have to do it this way to work around the Byte array assignment bug in VB6.
    Dim b() As Byte
    b = Key
    mTripleDES.Key = b
End Sub

Private Sub StartHash()
    If mHashStarted Then Exit Sub
    Set mStream = Cor.NewCryptoStream(mHashStream, mTripleDES.CreateEncryptor, WriteMode)
    mHashStarted = True
End Sub

Private Sub EndHash()
    Call mStream.FlushFinalBlock
    Call Initialize
    mHashStarted = False
End Sub

Private Sub ComputeHashOnStream(ByRef Source As Variant)
    If Source Is Nothing Then _
        Throw Cor.NewArgumentNullException("Source cannot be Nothing.", "Source")
    If Not TypeOf Source Is Stream Then _
        Throw Cor.NewArgumentException("Source must implement the Stream interface.", "Source")
    
    Dim Stream As Stream
    Set Stream = Source
    
    ReDim InputBuffer(4095) As Byte
    Dim BytesRead As Long
    Do
        BytesRead = Stream.ReadBlock(InputBuffer, 0, 4096)
        If BytesRead = 0 Then Exit Do
        Call mStream.WriteBlock(InputBuffer, 0, BytesRead)
    Loop
End Sub

Private Sub ComputeHashOnBytes(ByRef Source As Variant, ByRef Index As Variant, ByRef Count As Variant)
    Dim pSA As Long
    pSA = GetArrayPointer(Source)
    
    Dim Result      As Long
    Dim ElemIndex   As Long
    Dim ElemCount   As Long
    Result = GetOptionalArrayRange(pSA, Index, ElemIndex, Count, ElemCount)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Source", ElemIndex, "Index", ElemCount, "Count", IsMissing(Index))
    
    On Error GoTo errTrap
    Dim Bytes() As Byte
    SAPtr(Bytes) = pSA
    Call mStream.WriteBlock(Bytes, ElemIndex, ElemCount)

errTrap:
    SAPtr(Bytes) = vbNullPtr
    Throw
End Sub

Private Sub VerifyNotDisposed()
    If mDisposed Then
        Throw Cor.NewObjectDisposedException("SHA1CryptoServiceProvider", "The service provider has been disposed.")
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    Set mTripleDES = New TripleDESCryptoServiceProvider
    mTripleDES.Mode = CipherMode.CBC
    mTripleDES.IV = Cor.NewBytes(0, 0, 0, 0, 0, 0, 0, 0)
    Call mHashStream.Init(8)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IObject Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IObject_Equals(Value As Variant) As Boolean
    IObject_Equals = Equals(Value)
End Function

Private Function IObject_GetHashcode() As Long
    IObject_GetHashcode = GetHashCode
End Function

Private Function IObject_ToString() As String
    IObject_ToString = ToString
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   HashAlgorithm Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Property Get HashAlgorithm_CanReuseTransform() As Boolean
    HashAlgorithm_CanReuseTransform = CanReuseTransform
End Property

Private Property Get HashAlgorithm_CanTransformMultipleBlocks() As Boolean
    HashAlgorithm_CanTransformMultipleBlocks = CanTransformMultipleBlocks
End Property

Private Sub HashAlgorithm_Clear()
    Call Clear
End Sub

Private Function HashAlgorithm_ComputeHash(Source As Variant, Optional Index As Variant, Optional Count As Variant) As Byte()
    HashAlgorithm_ComputeHash = ComputeHash(Source, Index, Count)
End Function

Private Function HashAlgorithm_Equals(Value As Variant) As Boolean
    HashAlgorithm_Equals = Equals(Value)
End Function

Private Function HashAlgorithm_GetHashCode() As Long
    HashAlgorithm_GetHashCode = GetHashCode
End Function

Private Property Get HashAlgorithm_Hash() As Byte()
    HashAlgorithm_Hash = Hash
End Property

Private Property Get HashAlgorithm_HashSize() As Long
    HashAlgorithm_HashSize = HashSize
End Property

Private Sub HashAlgorithm_Initialize()
    Call Initialize
End Sub

Private Property Get HashAlgorithm_InputBlockSize() As Long
    HashAlgorithm_InputBlockSize = InputBlockSize
End Property

Private Property Get HashAlgorithm_OutputBlockSize() As Long
    HashAlgorithm_OutputBlockSize = OutputBlockSize
End Property

Private Function HashAlgorithm_ToString() As String
    HashAlgorithm_ToString = ToString
End Function

Private Function HashAlgorithm_TransformBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    HashAlgorithm_TransformBlock = TransformBlock(InputBuffer, InputOffset, InputCount, OutputBuffer, OutputOffset)
End Function

Private Function HashAlgorithm_TransformFinalBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    HashAlgorithm_TransformFinalBlock = TransformFinalBlock(InputBuffer, InputOffset, InputCount)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ICryptoTransform Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Property Get ICryptoTransform_CanReuseTransform() As Boolean
    ICryptoTransform_CanReuseTransform = CanReuseTransform
End Property

Private Property Get ICryptoTransform_CanTransformMultipleBlocks() As Boolean
    ICryptoTransform_CanTransformMultipleBlocks = CanTransformMultipleBlocks
End Property

Private Property Get ICryptoTransform_InputBlockSize() As Long
    ICryptoTransform_InputBlockSize = InputBlockSize
End Property

Private Property Get ICryptoTransform_OutputBlockSize() As Long
    ICryptoTransform_OutputBlockSize = OutputBlockSize
End Property

Private Function ICryptoTransform_TransformBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    ICryptoTransform_TransformBlock = TransformBlock(InputBuffer, InputOffset, InputCount, OutputBuffer, OutputOffset)
End Function

Private Function ICryptoTransform_TransformFinalBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    ICryptoTransform_TransformFinalBlock = TransformFinalBlock(InputBuffer, InputOffset, InputCount)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   KeyedHashAlgorithm Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Property Let KeyedHashAlgorithm_Key(RHS() As Byte)
    Call SetKey(RHS)
End Property

Private Property Get KeyedHashAlgorithm_Key() As Byte()
    KeyedHashAlgorithm = Key
End Property

Private Property Get KeyedHashAlgorithm_CanReuseTransform() As Boolean
    KeyedHashAlgorithm_CanReuseTransform = CanReuseTransform
End Property

Private Property Get KeyedHashAlgorithm_CanTransformMultipleBlocks() As Boolean
    KeyedHashAlgorithm_CanTransformMultipleBlocks = CanTransformMultipleBlocks
End Property

Private Sub KeyedHashAlgorithm_Clear()
    Call Clear
End Sub

Private Function KeyedHashAlgorithm_ComputeHash(Source As Variant, Optional Index As Variant, Optional Count As Variant) As Byte()
    KeyedHashAlgorithm_ComputeHash = ComputeHash(Source, Index, Count)
End Function

Private Function KeyedHashAlgorithm_Equals(Value As Variant) As Boolean
    KeyedHashAlgorithm_Equals = Equals(Value)
End Function

Private Function KeyedHashAlgorithm_GetHashCode() As Long
    KeyedHashAlgorithm_GetHashCode = GetHashCode
End Function

Private Property Get KeyedHashAlgorithm_Hash() As Byte()
    KeyedHashAlgorithm_Hash = Hash
End Property

Private Property Get KeyedHashAlgorithm_HashSize() As Long
    KeyedHashAlgorithm_HashSize = HashSize
End Property

Private Sub KeyedHashAlgorithm_Initialize()
    Call Initialize
End Sub

Private Property Get KeyedHashAlgorithm_InputBlockSize() As Long
    KeyedHashAlgorithm_InputBlockSize = InputBlockSize
End Property

Private Property Get KeyedHashAlgorithm_OutputBlockSize() As Long
    KeyedHashAlgorithm_OutputBlockSize = OutputBlockSize
End Property

Private Function KeyedHashAlgorithm_ToString() As String
    KeyedHashAlgorithm_ToString = ToString
End Function

Private Function KeyedHashAlgorithm_TransformBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    KeyedHashAlgorithm_TransformBlock = TransformBlock(InputBuffer, InputOffset, InputCount, OutputBuffer, OutputOffset)
End Function

Private Function KeyedHashAlgorithm_TransformFinalBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    KeyedHashAlgorithm_TransformFinalBlock = TransformFinalBlock(InputBuffer, InputOffset, InputCount)
End Function