sha512managed.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SHA512Managed"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2006 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: SHA512Managed
'

''
' Provides services to compute the SHA-512 hash value.
'
' @remarks The SHA-512 algorithm is implemented in Visual Basic.
' <p>Details can be found at http://csrc.nist.gov/CryptoToolkit/tkhash.html</p>
' @see HashAlgorithm
'
Option Explicit
Implements IObject
Implements HashAlgorithm
Implements ICryptoTransform
Implements SHA512
Implements IHashAlgorithm

Private mBase               As HashAlgorithmBase
Private mWh(0 To 79)        As Long
Private mWl(0 To 79)        As Long
Private mStateH(0 To 7)     As Long
Private mStateL(0 To 7)     As Long
Private mKh(0 To 79)        As Long
Private mKl(0 To 79)        As Long
Private mStatePtr           As DLong




''
' Returns if this service provider can be reused to transfrom more data.
'
' @return Always returns True.
'
Public Property Get CanReuseTransform() As Boolean
    CanReuseTransform = True
End Property

''
' Returns if this transform can operate on multiple blocks at once.
'
' @return Always returns True.
'
Public Property Get CanTransformMultipleBlocks() As Boolean
    CanTransformMultipleBlocks = True
End Property

''
' Returns the computed hash.
'
' @return A 64-byte array containing the hash value.
' @remarks The TransformFinalBlock must be called before accessing
' this property or an InvalidOperationException will be thrown.
'
Public Property Get Hash() As Byte()
    Hash = mBase.Hash
End Property

''
' Returns the size of the computed hash.
'
' @return Always returns 512 bits.
'
Public Property Get HashSize() As Long
    HashSize = 512
End Property

''
' Returns the input block size this transform can work on.
'
' @return Always returns 1.
' @remarks When calling the TransformBlock method, the InputCount must be zero or a multiple of this value.
'
Public Property Get InputBlockSize() As Long
    InputBlockSize = 1
End Property

''
' Returns the output block size this transform can produce.
'
' @return Always returns 1.
'
Public Property Get OutputBlockSize() As Long
    OutputBlockSize = 1
End Property

''
' Releases any resources.
'
Public Sub Clear()
    Call mBase.Clear
End Sub

''
' Computes a hash value for a source in a single pass.
'
' @param Source This can be either a Byte array or any Stream compatible object.
' @param Index The starting index in the Byte array. This is ignored for Stream objects.
' @param Count The number of bytes in the array to be computed. This is ignored for Stream objects.
' @return A 64-byte hash value.
' @remarks If a Stream object is passed in, then the stream is continuously read and the hash calculated until
' there is no more data left to read from the stream.
'
Public Function ComputeHash(ByRef Source As Variant, Optional ByRef Index As Variant, Optional ByRef Count As Variant) As Byte()
    ComputeHash = mBase.ComputeHash(Source, Index, Count)
End Function

''
' Resets the hashing algorithm to start again.
'
Public Sub Initialize()
    Erase mWh
    Erase mWl
    
    Call CopyMemory(mStateH(0), ByVal mStatePtr.HiDWord, 32)
    Call CopyMemory(mStateL(0), ByVal mStatePtr.LoDWord, 32)
    
    Call mBase.Initialize
End Sub

''
' Computes the hash for the specified block of data.
'
' @param InputBuffer The data to compute the hash from.
' @param InputOffset The starting index in the input data to compute the hash.
' @param InputCount The number of bytes to compute the hash from.
' @param OutputBuffer The array to place the input buffer bytes in.
' @param OutputOffset The starting index to beging copying the bytes to.
' @return The number of bytes processed.
' @remarks The OutputBuffer will contain the same data as the InputBuffer. No hash values are placed in the OutputBuffer.
' <p>If the OutputBuffer is a Null Array, or is the same array as the InputBuffer and the OutputOffset equals the InputOffset, then nothing is copied, however, the hash is still computed
' on the InputBuffer data.</p>
' <p>The TransformFinalBlock needs to be called to finish computing the hash, this method alone cannot compute the entire hash.</p>
'
Public Function TransformBlock(ByRef InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, ByRef OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    TransformBlock = mBase.TransformBlock(InputBuffer, InputOffset, InputCount, OutputBuffer, OutputOffset)
End Function

''
' Computes the final hash value.
'
' @param InputBuffer The final block of data to compute the hash for.
' @param InputOffset The index in the InputBuffer to begin computing data.
' @param InputCount The number of bytes to be processed.
' @return Returns the section of the InputBuffer that was processed.
' @remarks This does not return the computed hash value. A copy of the data that was
' process is returned. To retrieve the hash value, call the Hash property.
'
Public Function TransformFinalBlock(ByRef InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    TransformFinalBlock = mBase.TransformFinalBlock(InputBuffer, InputOffset, InputCount)
End Function

''
' This function determines if the value passed in is the same
' as the current object instance. Meaning, are the Value and
' this object the same object in memory.
'
' @param Value The value to compare against this instance.
' @return Returns True if the values are the same.
'
Public Function Equals(ByRef Value As Variant) As Boolean
    Equals = Object.Equals(Me, Value)
End Function

''
' Returns a psuedo-unique number used to help identify this
' object in memory. The current method is to return the value
' obtained from ObjPtr. If a different method needs to be impelmented
' then change the method here in this function.
'
' @return Returns a number identifing this instance.
'
Public Function GetHashCode() As Long
    GetHashCode = ObjPtr(CUnk(Me))
End Function

''
' Returns a string representation of this object instance.
' The default method simply returns the application name
' and class name in which this class resides.
'
' @return Returns a string representation of this instance.
'
Public Function ToString() As String
    ToString = Object.ToString(Me, App)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByRef StatePtr As DLong)
    mStatePtr = StatePtr
    Call Initialize
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function HashFinal(ByRef Buffer() As Byte, ByVal BufferCount As Long, ByVal MessageLength As Currency) As Byte()
    Buffer(BufferCount) = &H80
    BufferCount = BufferCount + 1

    Dim Size As Long
    Size = IIf(BufferCount > 112, 256, 128)

    Dim FinalBuffer() As Byte
    ReDim FinalBuffer(0 To Size - 1)
    Call CopyMemory(FinalBuffer(0), Buffer(0), BufferCount)

    Dim i As Long
    With AsOByteArr(MessageLength * 0.0008@)
        For i = 0 To 7
            FinalBuffer(Size - i - 1) = .Bytes(i)
        Next i
    End With

    Call Transform(FinalBuffer, 0)
    If Size = 256 Then Call Transform(FinalBuffer, 128)

    Dim Ret() As Byte
    ReDim Ret(63)
    For i = 0 To 7
        AsLong(Ret(i * 8)) = SwapEndian(mStateH(i))
        AsLong(Ret(i * 8 + 4)) = SwapEndian(mStateL(i))
    Next i

    HashFinal = Ret
End Function

Private Sub Transform(ByRef Bytes() As Byte, ByVal Index As Long)
    If InIDE Then
        Call TransformIDE(Bytes, Index)
    Else
        Call TransformNative(Bytes, Index)
    End If
End Sub

''
' Runs in the IDE.
'
Private Sub TransformIDE(ByRef Bytes() As Byte, ByVal Index As Long)
    Dim i As Long
    For i = 0 To 15
        mWh(i) = SwapEndian(AsLong(Bytes(Index)))
        mWl(i) = SwapEndian(AsLong(Bytes(Index + 4)))
        Index = Index + 8
    Next i
    
    Dim T1l As Long
    Dim T1h As Long
    Dim T2l As Long
    Dim T2h As Long
    Dim s0l As Long
    Dim s0h As Long
    Dim s1l As Long
    Dim s1h As Long
    For i = 16 To 79
        T1l = mWl(i - 2)
        T1h = mWh(i - 2)
        s1l = LilSig1Lo(T1h, T1l)
        s1h = LilSig1Hi(T1h, T1l)

        T2l = mWl(i - 15)
        T2h = mWh(i - 15)
        s0l = LilSig0Lo(T2h, T2l)
        s0h = LilSig0Hi(T2h, T2l)
        
        Call UAdd64(s1h, s1l, mWh(i - 7), mWl(i - 7))
        Call UAdd64(s1h, s1l, s0h, s0l)
        Call UAdd64(s1h, s1l, mWh(i - 16), mWl(i - 16))

        mWh(i) = s1h
        mWl(i) = s1l
    Next i
    
    Dim Ah As Long, Al As Long
    Dim Bh As Long, Bl As Long
    Dim Ch As Long, Cl As Long
    Dim Dh As Long, Dl As Long
    Dim Eh As Long, El As Long
    Dim Fh As Long, Fl As Long
    Dim Gh As Long, Gl As Long
    Dim Hh As Long, Hl As Long
    
    Ah = mStateH(0): Al = mStateL(0)
    Bh = mStateH(1): Bl = mStateL(1)
    Ch = mStateH(2): Cl = mStateL(2)
    Dh = mStateH(3): Dl = mStateL(3)
    Eh = mStateH(4): El = mStateL(4)
    Fh = mStateH(5): Fl = mStateL(5)
    Gh = mStateH(6): Gl = mStateL(6)
    Hh = mStateH(7): Hl = mStateL(7)
    
    For i = 0 To 79
        T1h = Hh: T1l = Hl
        Call UAdd64(T1h, T1l, BigSIG1Hi(Eh, El), BigSIG1Lo(Eh, El))
        Call UAdd64(T1h, T1l, Choice(Eh, Fh, Gh), Choice(El, Fl, Gl))
        Call UAdd64(T1h, T1l, mKh(i), mKl(i))
        Call UAdd64(T1h, T1l, mWh(i), mWl(i))

        T2h = BigSIG0Hi(Ah, Al): T2l = BigSIG0Lo(Ah, Al)
        Call UAdd64(T2h, T2l, Maj(Ah, Bh, Ch), Maj(Al, Bl, Cl))

        Hh = Gh: Hl = Gl
        Gh = Fh: Gl = Fl
        Fh = Eh: Fl = El
        Eh = Dh: El = Dl
        Call UAdd64(Eh, El, T1h, T1l)
        Dh = Ch: Dl = Cl
        Ch = Bh: Cl = Bl
        Bh = Ah: Bl = Al
        Ah = T1h: Al = T1l
        Call UAdd64(Ah, Al, T2h, T2l)
    Next i
    
    Call UAdd64(mStateH(0), mStateL(0), Ah, Al)
    Call UAdd64(mStateH(1), mStateL(1), Bh, Bl)
    Call UAdd64(mStateH(2), mStateL(2), Ch, Cl)
    Call UAdd64(mStateH(3), mStateL(3), Dh, Dl)
    Call UAdd64(mStateH(4), mStateL(4), Eh, El)
    Call UAdd64(mStateH(5), mStateL(5), Fh, Fl)
    Call UAdd64(mStateH(6), mStateL(6), Gh, Gl)
    Call UAdd64(mStateH(7), mStateL(7), Hh, Hl)
End Sub

Private Sub UAdd64(ByRef xh As Long, ByRef xl As Long, ByVal yh As Long, ByVal yl As Long)
    Call Helper.UAdd64(xh, xl, yh, yl)
End Sub

Private Function RShiftHi(ByVal xh As Long, ByVal xl As Long, ByVal Count As Long) As Long
    If Count < 32 Then RShiftHi = Helper.ShiftRight(xh, Count)
End Function

Private Function RShiftLo(ByVal xh As Long, ByVal xl As Long, ByVal Count As Long) As Long
    If Count < 32 Then
        RShiftLo = Helper.ShiftLeft(xh, 32 - Count) Or Helper.ShiftRight(xl, Count)
    Else
        RShiftLo = Helper.ShiftRight(xh, Count - 32)
    End If
End Function

Private Function RRotateHi(ByVal xh As Long, ByVal xl As Long, ByVal Count As Long) As Long
    If Count < 32 Then
        RRotateHi = Helper.ShiftRight(xh, Count) Or Helper.ShiftLeft(xl, 32 - Count)
    Else
        RRotateHi = Helper.ShiftLeft(xh, 64 - Count) Or Helper.ShiftRight(xl, Count - 32)
    End If
End Function

Private Function RRotateLo(ByVal xh As Long, ByVal xl As Long, ByVal Count As Long) As Long
    If Count < 32 Then
        RRotateLo = Helper.ShiftLeft(xh, 32 - Count) Or Helper.ShiftRight(xl, Count)
    Else
        RRotateLo = Helper.ShiftRight(xh, Count - 32) Or Helper.ShiftLeft(xl, 64 - Count)
    End If
End Function

Private Function Choice(ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long
    Choice = (x And y) Xor ((Not x) And z)
End Function

Private Function Maj(ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long
    Maj = (x And y) Xor (x And z) Xor (y And z)
End Function

Private Function BigSIG0Hi(ByVal xh As Long, ByVal xl As Long) As Long
    BigSIG0Hi = RRotateHi(xh, xl, 28) Xor RRotateHi(xh, xl, 34) Xor RRotateHi(xh, xl, 39)
End Function