کد برای Hash کردن برای VB

[بابک زواری]

دوستانی که میخوان دیتاهاشون رو هش Hash کنن از کد زیر میتونن استفاده کنن

Private m_lOnBits(30)

Private m_l2Power(30)

Private K(63)



Private Const BITS_TO_A_BYTE = 8

Private Const BYTES_TO_A_WORD = 4

Private Const BITS_TO_A_WORD = 32



Public Sub loadArrayValues()

    m_lOnBits(0) = CLng(1)

    m_lOnBits(1) = CLng(3)

    m_lOnBits(2) = CLng(7)

    m_lOnBits(3) = CLng(15)

    m_lOnBits(4) = CLng(31)

    m_lOnBits(5) = CLng(63)

    m_lOnBits(6) = CLng(127)

    m_lOnBits(7) = CLng(255)

    m_lOnBits(8) = CLng(511)

    m_lOnBits(9) = CLng(1023)

    m_lOnBits(10) = CLng(2047)

    m_lOnBits(11) = CLng(4095)

    m_lOnBits(12) = CLng(8191)

    m_lOnBits(13) = CLng(16383)

    m_lOnBits(14) = CLng(32767)

    m_lOnBits(15) = CLng(65535)

    m_lOnBits(16) = CLng(131071)

    m_lOnBits(17) = CLng(262143)

    m_lOnBits(18) = CLng(524287)

    m_lOnBits(19) = CLng(1048575)

    m_lOnBits(20) = CLng(2097151)

    m_lOnBits(21) = CLng(4194303)

    m_lOnBits(22) = CLng(8388607)

    m_lOnBits(23) = CLng(16777215)

    m_lOnBits(24) = CLng(33554431)

    m_lOnBits(25) = CLng(67108863)

    m_lOnBits(26) = CLng(134217727)

    m_lOnBits(27) = CLng(268435455)

    m_lOnBits(28) = CLng(536870911)

    m_lOnBits(29) = CLng(1073741823)

    m_lOnBits(30) = CLng(2147483647)

    

    m_l2Power(0) = CLng(1)

    m_l2Power(1) = CLng(2)

    m_l2Power(2) = CLng(4)

    m_l2Power(3) = CLng(8)

    m_l2Power(4) = CLng(16)

    m_l2Power(5) = CLng(32)

    m_l2Power(6) = CLng(64)

    m_l2Power(7) = CLng(128)

    m_l2Power(8) = CLng(256)

    m_l2Power(9) = CLng(512)

    m_l2Power(10) = CLng(1024)

    m_l2Power(11) = CLng(2048)

    m_l2Power(12) = CLng(4096)

    m_l2Power(13) = CLng(8192)

    m_l2Power(14) = CLng(16384)

    m_l2Power(15) = CLng(32768)

    m_l2Power(16) = CLng(65536)

    m_l2Power(17) = CLng(131072)

    m_l2Power(18) = CLng(262144)

    m_l2Power(19) = CLng(524288)

    m_l2Power(20) = CLng(1048576)

    m_l2Power(21) = CLng(2097152)

    m_l2Power(22) = CLng(4194304)

    m_l2Power(23) = CLng(8388608)

    m_l2Power(24) = CLng(16777216)

    m_l2Power(25) = CLng(33554432)

    m_l2Power(26) = CLng(67108864)

    m_l2Power(27) = CLng(134217728)

    m_l2Power(28) = CLng(268435456)

    m_l2Power(29) = CLng(536870912)

    m_l2Power(30) = CLng(1073741824)

        

    K(0) = &H428A2F98

    K(1) = &H71374491

    K(2) = &HB5C0FBCF

    K(3) = &HE9B5DBA5

    K(4) = &H3956C25B

    K(5) = &H59F111F1

    K(6) = &H923F82A4

    K(7) = &HAB1C5ED5

    K(8) = &HD807AA98

    K(9) = &H12835B01

    K(10) = &H243185BE

    K(11) = &H550C7DC3

    K(12) = &H72BE5D74

    K(13) = &H80DEB1FE

    K(14) = &H9BDC06A7

    K(15) = &HC19BF174

    K(16) = &HE49B69C1

    K(17) = &HEFBE4786

    K(18) = &HFC19DC6

    K(19) = &H240CA1CC

    K(20) = &H2DE92C6F

    K(21) = &H4A7484AA

    K(22) = &H5CB0A9DC

    K(23) = &H76F988DA

    K(24) = &H983E5152

    K(25) = &HA831C66D

    K(26) = &HB00327C8

    K(27) = &HBF597FC7

    K(28) = &HC6E00BF3

    K(29) = &HD5A79147

    K(30) = &H6CA6351

    K(31) = &H14292967

    K(32) = &H27B70A85

    K(33) = &H2E1B2138

    K(34) = &H4D2C6DFC

    K(35) = &H53380D13

    K(36) = &H650A7354

    K(37) = &H766A0ABB

    K(38) = &H81C2C92E

    K(39) = &H92722C85

    K(40) = &HA2BFE8A1

    K(41) = &HA81A664B

    K(42) = &HC24B8B70

    K(43) = &HC76C51A3

    K(44) = &HD192E819

    K(45) = &HD6990624

    K(46) = &HF40E3585

    K(47) = &H106AA070

    K(48) = &H19A4C116

    K(49) = &H1E376C08

    K(50) = &H2748774C

    K(51) = &H34B0BCB5

    K(52) = &H391C0CB3

    K(53) = &H4ED8AA4A

    K(54) = &H5B9CCA4F

    K(55) = &H682E6FF3

    K(56) = &H748F82EE

    K(57) = &H78A5636F

    K(58) = &H84C87814

    K(59) = &H8CC70208

    K(60) = &H90BEFFFA

    K(61) = &HA4506CEB

    K(62) = &HBEF9A3F7

    K(63) = &HC67178F2



End Sub



Private Function LShift(lValue, iShiftBits)

    If iShiftBits = 0 Then

        LShift = lValue

        Exit Function

    ElseIf iShiftBits = 31 Then

        If lValue And 1 Then

            LShift = &H80000000

        Else

            LShift = 0

        End If

        Exit Function

    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then

        Err.Raise 6

    End If

    

    If (lValue And m_l2Power(31 - iShiftBits)) Then

        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000

    Else

        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))

    End If

End Function



Private Function RShift(lValue, iShiftBits)

    If iShiftBits = 0 Then

        RShift = lValue

        Exit Function

    ElseIf iShiftBits = 31 Then

        If lValue And &H80000000 Then

            RShift = 1

        Else

            RShift = 0

        End If

        Exit Function

    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then

        Err.Raise 6

    End If

    

    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    

    If (lValue And &H80000000) Then

        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))

    End If

End Function



Private Function AddUnsigned(lX, lY)

    Dim lX4

    Dim lY4

    Dim lX8

    Dim lY8

    Dim lResult

 

    lX8 = lX And &H80000000

    lY8 = lY And &H80000000

    lX4 = lX And &H40000000

    lY4 = lY And &H40000000

 

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

 

    If lX4 And lY4 Then

        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8

    ElseIf lX4 Or lY4 Then

        If lResult And &H40000000 Then

            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8

        Else

            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8

        End If

    Else

        lResult = lResult Xor lX8 Xor lY8

    End If

 

    AddUnsigned = lResult

End Function



Private Function Ch(x, y, z)

    Ch = ((x And y) Xor ((Not x) And z))

End Function



Private Function Maj(x, y, z)

    Maj = ((x And y) Xor (x And z) Xor (y And z))

End Function



Private Function S(x, n)

    S = (RShift(x, (n And m_lOnBits(4))) Or LShift(x, (32 - (n And m_lOnBits(4)))))

End Function



Private Function R(x, n)

    R = RShift(x, CLng(n And m_lOnBits(4)))

End Function



Private Function Sigma0(x)

    Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))

End Function



Private Function Sigma1(x)

    Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))

End Function



Private Function Gamma0(x)

    Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))

End Function



Private Function Gamma1(x)

    Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))

End Function



Private Function ConvertToWordArray(sMessage)

    Dim lMessageLength

    Dim lNumberOfWords

    Dim lWordArray()

    Dim lBytePosition

    Dim lByteCount

    Dim lWordCount

    Dim lByte

    

    Const MODULUS_BITS = 512

    Const CONGRUENT_BITS = 448

    

    lMessageLength = Len(sMessage)

    

    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)

    ReDim lWordArray(lNumberOfWords - 1)

    

    lBytePosition = 0

    lByteCount = 0

    Do Until lByteCount >= lMessageLength

        lWordCount = lByteCount \ BYTES_TO_A_WORD

        

        lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE

        

        lByte = AscB(Mid(sMessage, lByteCount + 1, 1))

        

        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)

        lByteCount = lByteCount + 1

    Loop



    lWordCount = lByteCount \ BYTES_TO_A_WORD

    lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE



    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)



    lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)

    lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)

    

    ConvertToWordArray = lWordArray

End Function



Public Function SHA256(sMessage)

    Dim HASH(7)

    Dim M

    Dim W(63)

    Dim a

    Dim b

    Dim c

    Dim d

    Dim e

    Dim f

    Dim g

    Dim h

    Dim i

    Dim j

    Dim T1

    Dim T2

    

    HASH(0) = &H6A09E667

    HASH(1) = &HBB67AE85

    HASH(2) = &H3C6EF372

    HASH(3) = &HA54FF53A

    HASH(4) = &H510E527F

    HASH(5) = &H9B05688C

    HASH(6) = &H1F83D9AB

    HASH(7) = &H5BE0CD19

    

    M = ConvertToWordArray(sMessage)

    

    For i = 0 To UBound(M) Step 16

        a = HASH(0)

        b = HASH(1)

        c = HASH(2)

        d = HASH(3)

        e = HASH(4)

        f = HASH(5)

        g = HASH(6)

        h = HASH(7)

        

        For j = 0 To 63

            If j < 16 Then

                W(j) = M(j + i)

            Else

                W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Ga  mma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))

            End If

                

            T1 = AddUnsigned(AddUnsigned(AddUnsigned(Ad  dUnsigned(h, Sigma1(e)), Ch(e, f, g)), K(j)), W(j))

            T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))

            

            h = g

            g = f

            f = e

            e = AddUnsigned(d, T1)

            d = c

            c = b

            b = a

            a = AddUnsigned(T1, T2)

        Next

        

        HASH(0) = AddUnsigned(a, HASH(0))

        HASH(1) = AddUnsigned(b, HASH(1))

        HASH(2) = AddUnsigned(c, HASH(2))

        HASH(3) = AddUnsigned(d, HASH(3))

        HASH(4) = AddUnsigned(e, HASH(4))

        HASH(5) = AddUnsigned(f, HASH(5))

        HASH(6) = AddUnsigned(g, HASH(6))

        HASH(7) = AddUnsigned(h, HASH(7))

    Next

    

    SHA256 = LCase(Right("00000000" & Hex(HASH(0)), 8) & Right("00000000" & Hex(HASH(1)), 8) & Right("00000000" & Hex(HASH(2)), 8) & Right("00000000" & Hex(HASH(3)), 8) & Right("00000000" & Hex(HASH(4)), 8) & Right("00000000" & Hex(HASH(5)), 8) & Right("00000000" & Hex(HASH(6)), 8) & Right("00000000" & Hex(HASH(7)), 8))

End Function



'## Original Code End ##



'## Visual Design Studios Code Starts ##



Public Function compareStrings(strToCompare As String, strOriginal As String) As Boolean

    'This function is designed for string comparison ie. to check whether one string matches the other for example checking an entered password against a stored encrypted password

    'strToCompare is the String you wish to check

    'strOriginal is a hashed String that strToCompare should match

    

    Dim strCheck As String

    strCheck = SHA256(strToCompare)

    

    If strCheck = strOriginal Then

        compareStrings = True

    Else

        compareStrings = False

    End If

End Function

[Hamedm]

ممنون :flower:

[بابک زواری]

دوستان توجه کنن که اطلاعات که با روش هش کد Code شد دیگه قابل دیکدDecode شدن نیست
فکر کنم که مقاله ایی در این زمینه تو سایت هست جالبه خوندنش

[Hamedm]

میشه لینکشو بدید :oops:

[M-Gheibi]

در بخش رمز نگاری داده ها (Cryptography) اطلاعات خوبی در این زمینه موجود است.

[sammy]

آقا ببخشید میشه بفرمایین منظور از Hash چیه؟

[M-Gheibi]

آقا ببخشید میشه بفرمایین منظور از Hash چیه؟

Hash : هش یا چکیدهء پیام یا هر اسم دیگه ای که روش میگذارن ، روشی برای تولید چکیده و خلاصه از یک پیام ، فایل و ... است . هش با استفاده از قواعد و الگوریتمهای مخصوص به خودش تلاش میکنه ، از هر چیزی که بهش داده میشه ، یک چکیده با طولی همیشه ثابت تولید کنه . به عنوان مثال الگوریتم MD5 که یکی از روشهای متداول تولید هش است ، به ازای هر نوع ورودی که دریافت کنه ( چه یک حرف باشه چه یک فایل ده گیگا بایتی ) همیشه ، فقط و فقط 128 بیت خروجی تولید میکنه . این خروجی 128 بیتی ، تا وقتی فایل یا پیام تغییر نکرده باشه ، همیشه ثابت خواهد بود . نتیجه : استفاده از هش برای تولید چکیده میتونه روش خوبی برای بررسی تغییر یا عدم تغییر در یک پیام یا فایل باشه . نتیجه بعد : خروجی تولید شده توسط یک الگوریتم هش هرگز به موجودیت اولیه قابل بازگردانی نیست . کاربرد : تولید امضای دیجیتال . حوزه کاربرد : عموما" سیستمهای مبتنی بر PKI .

http://www.barnamenevis.org/viewtopic.php?t=19762