Koodit: QB: MD5-tiivisteen laskeminen

'hyvaan ohjelmointityyliin kuuluu kuvaavat funktioiden nimet :)
DECLARE FUNCTION asctobin$ (a AS STRING)
DECLARE FUNCTION bintohex$ (a AS STRING)
DECLARE FUNCTION hextobin$ (a AS STRING)

'sadd oli kai joku valmis funktio tai joku sellainen QAQ
's siis tulee sanasta "string" :)
DECLARE FUNCTION stadd$ (a AS STRING, b AS STRING)
DECLARE FUNCTION sand$ (a AS STRING, b AS STRING)
DECLARE FUNCTION sor$ (a AS STRING, b AS STRING)
DECLARE FUNCTION snot$ (a AS STRING)
DECLARE FUNCTION sxor$ (a AS STRING, b AS STRING)
DECLARE FUNCTION lrotate$ (a AS STRING, b AS LONG)

'naa on vaan suoraan ne sielta baberista...
DECLARE FUNCTION flol$ (a AS STRING, b AS STRING, c AS STRING)
DECLARE FUNCTION glol$ (a AS STRING, b AS STRING, c AS STRING)
DECLARE FUNCTION ilol$ (a AS STRING, b AS STRING, c AS STRING)
DECLARE FUNCTION hlol$ (a AS STRING, b AS STRING, c AS STRING)

DECLARE FUNCTION r1$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
DECLARE FUNCTION r2$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
DECLARE FUNCTION r3$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
DECLARE FUNCTION r4$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, t AS LONG)


DEFLNG A-Z

DIM a AS STRING
DIM b AS STRING
DIM c AS STRING
DIM d AS STRING
DIM aa AS STRING
DIM bb AS STRING
DIM cc AS STRING
DIM dd AS STRING
DIM SHARED x(16) AS STRING
DIM SHARED t(64) AS STRING 'sinifunktiollakin voisi laskea. minua tosin huoletti vahan ohjelman suorituskyky ja tein nain
DIM syote AS STRING

'jotain maagisia lukuja ei hajuakaan. jannaa :oooo
a = hextobin("67452301")
b = hextobin("efcdab89")
c = hextobin("98badcfe")
d = hextobin("10325476")


FOR i = 0 TO 16
    x(i) = hextobin("00000000")
NEXT

t(1) = hextobin("d76aa478")
t(2) = hextobin("e8c7b756")
t(3) = hextobin("242070db")
t(4) = hextobin("c1bdceee")
t(5) = hextobin("f57c0faf")
t(6) = hextobin("4787c62a")
t(7) = hextobin("a8304613")
t(8) = hextobin("fd469501")
t(9) = hextobin("698098d8")
t(10) = hextobin("8b44f7af")
t(11) = hextobin("ffff5bb1")
t(12) = hextobin("895cd7be")
t(13) = hextobin("6b901122")
t(14) = hextobin("fd987193")
t(15) = hextobin("a679438e")
t(16) = hextobin("49b40821")
t(17) = hextobin("f61e2562")
t(18) = hextobin("c040b340")
t(19) = hextobin("265e5a51")
t(20) = hextobin("e9b6c7aa")
t(21) = hextobin("d62f105d")
t(22) = hextobin("02441453")
t(23) = hextobin("d8a1e681")
t(24) = hextobin("e7d3fbc8")
t(25) = hextobin("21e1cde6")
t(26) = hextobin("c33707d6")
t(27) = hextobin("f4d50d87")
t(28) = hextobin("455a14ed")
t(29) = hextobin("a9e3e905")
t(30) = hextobin("fcefa3f8")
t(31) = hextobin("676f02d9")
t(32) = hextobin("8d2a4c8a")
t(33) = hextobin("fffa3942")
t(34) = hextobin("8771f681")
t(35) = hextobin("6d9d6122")
t(36) = hextobin("fde5380c")
t(37) = hextobin("a4beea44")
t(38) = hextobin("4bdecfa9")
t(39) = hextobin("f6bb4b60")
t(40) = hextobin("bebfbc70")
t(41) = hextobin("289b7ec6")
t(42) = hextobin("eaa127fa")
t(43) = hextobin("d4ef3085")
t(44) = hextobin("04881d05")
t(45) = hextobin("d9d4d039")
t(46) = hextobin("e6db99e5")
t(47) = hextobin("1fa27cf8")
t(48) = hextobin("c4ac5665")
t(49) = hextobin("f4292244")
t(50) = hextobin("432aff97")
t(51) = hextobin("ab9423a7")
t(52) = hextobin("fc93a039")
t(53) = hextobin("655b59c3")
t(54) = hextobin("8f0ccc92")
t(55) = hextobin("ffeff47d")
t(56) = hextobin("85845dd1")
t(57) = hextobin("6fa87e4f")
t(58) = hextobin("fe2ce6e0")
t(59) = hextobin("a3014314")
t(60) = hextobin("4e0811a1")
t(61) = hextobin("f7537e82")
t(62) = hextobin("bd3af235")
t(63) = hextobin("2ad7d2bb")
t(64) = hextobin("eb86d391")

CLS

INPUT "Anna syote: ", syote

'p tulee sanasta "pituus" ja a sanasta "aluksi". Loogista, eiko totta!
pa = LEN(syote)

'lisataan loppuun ykkosbitti
syote = syote + CHR$(&H80)

WHILE LEN(syote) MOD 64 <> 56 'elikkas siis pitaa olla kongruentti 488 (mod 512)
    syote = syote + CHR$(0)
WEND

'syotteen alkuperainen pituus bitteina lisataan syotteen loppuun
pa = pa * 8
WHILE pa
    syote = syote + CHR$(pa MOD 256) 'kaantyy sitten myohemmin toisin pain bittijarjestyksen muuttuessa
    pa = pa \ 256
WEND

'taytetaan nollilla loppu
WHILE LEN(syote) MOD 64 <> 0
    syote = syote + CHR$(0)
WEND

'kasitellaan 512 bitin osissa
'vinkki: taman voi toteuttaa myos funktiona (hyva kotitehtava!)
FOR i = 0 TO LEN(syote) - 1 STEP 64
    aa = a
    bb = b
    cc = c
    dd = d

    'little endian vahan monimutkaistaa
    FOR j = 0 TO 64
        MID$(x(j \ 4), ((3 - (j MOD 4)) * 8) + 1) = asctobin(MID$(syote, (j + i) + 1, 1))
    NEXT

    a = r1(a, b, c, d, 0, 7, 1)
    d = r1(d, a, b, c, 1, 12, 2)
    c = r1(c, d, a, b, 2, 17, 3)
    b = r1(b, c, d, a, 3, 22, 4)

    a = r1(a, b, c, d, 4, 7, 5)
    d = r1(d, a, b, c, 5, 12, 6)
    c = r1(c, d, a, b, 6, 17, 7)
    b = r1(b, c, d, a, 7, 22, 8)

    a = r1(a, b, c, d, 8, 7, 9)
    d = r1(d, a, b, c, 9, 12, 10)
    c = r1(c, d, a, b, 10, 17, 11)
    b = r1(b, c, d, a, 11, 22, 12)

    a = r1(a, b, c, d, 12, 7, 13)
    d = r1(d, a, b, c, 13, 12, 14)
    c = r1(c, d, a, b, 14, 17, 15)
    b = r1(b, c, d, a, 15, 22, 16)


    a = r2(a, b, c, d, 1, 5, 17)
    d = r2(d, a, b, c, 6, 9, 18)
    c = r2(c, d, a, b, 11, 14, 19)
    b = r2(b, c, d, a, 0, 20, 20)

    a = r2(a, b, c, d, 5, 5, 21)
    d = r2(d, a, b, c, 10, 9, 22)
    c = r2(c, d, a, b, 15, 14, 23)
    b = r2(b, c, d, a, 4, 20, 24)

    a = r2(a, b, c, d, 9, 5, 25)
    d = r2(d, a, b, c, 14, 9, 26)
    c = r2(c, d, a, b, 3, 14, 27)
    b = r2(b, c, d, a, 8, 20, 28)

    a = r2(a, b, c, d, 13, 5, 29)
    d = r2(d, a, b, c, 2, 9, 30)
    c = r2(c, d, a, b, 7, 14, 31)
    b = r2(b, c, d, a, 12, 20, 32)


    a = r3(a, b, c, d, 5, 4, 33)
    d = r3(d, a, b, c, 8, 11, 34)
    c = r3(c, d, a, b, 11, 16, 35)
    b = r3(b, c, d, a, 14, 23, 36)

    a = r3(a, b, c, d, 1, 4, 37)
    d = r3(d, a, b, c, 4, 11, 38)
    c = r3(c, d, a, b, 7, 16, 39)
    b = r3(b, c, d, a, 10, 23, 40)

    a = r3(a, b, c, d, 13, 4, 41)
    d = r3(d, a, b, c, 0, 11, 42)
    c = r3(c, d, a, b, 3, 16, 43)
    b = r3(b, c, d, a, 6, 23, 44)

    a = r3(a, b, c, d, 9, 4, 45)
    d = r3(d, a, b, c, 12, 11, 46)
    c = r3(c, d, a, b, 15, 16, 47)
    b = r3(b, c, d, a, 2, 23, 48)


    a = r4(a, b, c, d, 0, 6, 49)
    d = r4(d, a, b, c, 7, 10, 50)
    c = r4(c, d, a, b, 14, 15, 51)
    b = r4(b, c, d, a, 5, 21, 52)

    a = r4(a, b, c, d, 12, 6, 53)
    d = r4(d, a, b, c, 3, 10, 54)
    c = r4(c, d, a, b, 10, 15, 55)
    b = r4(b, c, d, a, 1, 21, 56)

    a = r4(a, b, c, d, 8, 6, 57)
    d = r4(d, a, b, c, 15, 10, 58)
    c = r4(c, d, a, b, 6, 15, 59)
    b = r4(b, c, d, a, 13, 21, 60)

    a = r4(a, b, c, d, 4, 6, 61)
    d = r4(d, a, b, c, 11, 10, 62)
    c = r4(c, d, a, b, 2, 15, 63)
    b = r4(b, c, d, a, 9, 21, 64)


    a = stadd(a, aa)
    b = stadd(b, bb)
    c = stadd(c, cc)
    d = stadd(d, dd)
NEXT

'sitten vaihdetaan heksoiksi

a = bintohex(a)
b = bintohex(b)
c = bintohex(c)
d = bintohex(d)

'vaihdetaan tavujarjestysta, siksi vahan hassu :o
FOR i = 1 TO 4
    FOR j = 7 TO 1 STEP -2
        IF i = 1 THEN PRINT MID$(a, j, 2);
        IF i = 2 THEN PRINT MID$(b, j, 2);
        IF i = 3 THEN PRINT MID$(c, j, 2);
        IF i = 4 THEN PRINT MID$(d, j, 2);
    NEXT
NEXT

'muuttaa merkkijonon binaariluvuksi
FUNCTION asctobin$ (a AS STRING)
    d$ = ""
    FOR i = 1 TO LEN(a)
        b$ = ""
        c = ASC(MID$(a, i, 1))
        p = 0
        WHILE c > 0
            b$ = b$ + CHR$((c MOD 2) + 48)
            c = c \ 2
            p = p + 1
        WEND
        FOR j = p TO 7
            b$ = b$ + "0"
        NEXT
        FOR j = 8 TO 1 STEP -1
            d$ = d$ + MID$(b$, j, 1)
        NEXT
    NEXT
    asctobin$ = d$
END FUNCTION

FUNCTION bintohex$ (a AS STRING)
    b$ = ""
    DIM c(16) AS STRING
    c(1) = "0000"
    c(2) = "0001"
    c(3) = "0010"
    c(4) = "0011"
    c(5) = "0100"
    c(6) = "0101"
    c(7) = "0110"
    c(8) = "0111"
    c(9) = "1000"
    c(10) = "1001"
    c(11) = "1010"
    c(12) = "1011"
    c(13) = "1100"
    c(14) = "1101"
    c(15) = "1110"
    c(16) = "1111"
    d$ = "abcdef"
    FOR i = 1 TO LEN(a) STEP 4
        FOR j = 1 TO 16
            IF MID$(a, i, 4) = c(j) THEN
                IF j < 11 THEN
                    b$ = b$ + CHR$(j - 1 + 48)
                ELSE
                    b$ = b$ + MID$(d$, j - 10, 1)
                END IF
            END IF
        NEXT
    NEXT
    bintohex$ = b$
END FUNCTION

FUNCTION flol$ (a AS STRING, b AS STRING, c AS STRING)
    flol$ = sor(sand(a, b), sand(snot(a), c))
END FUNCTION

FUNCTION glol$ (a AS STRING, b AS STRING, c AS STRING)
    glol$ = sor(sand(a, c), sand(b, snot(c)))
END FUNCTION

FUNCTION hextobin$ (a AS STRING)
    d$ = ""
    DIM e(16) AS STRING
    e(1) = "0000"
    e(2) = "0001"
    e(3) = "0010"
    e(4) = "0011"
    e(5) = "0100"
    e(6) = "0101"
    e(7) = "0110"
    e(8) = "0111"
    e(9) = "1000"
    e(10) = "1001"
    e(11) = "1010"
    e(12) = "1011"
    e(13) = "1100"
    e(14) = "1101"
    e(15) = "1110"
    e(16) = "1111"
    FOR i = 1 TO LEN(a)
        c = ASC(MID$(a, i, 1))
        IF c > 64 THEN
            d$ = d$ + e(c - 86)
        ELSE
            d$ = d$ + e(c - 47)
        END IF
    NEXT
    hextobin$ = d$
END FUNCTION

FUNCTION hlol$ (a AS STRING, b AS STRING, c AS STRING)
    hlol$ = sxor(a, sxor(b, c))
END FUNCTION

FUNCTION ilol$ (a AS STRING, b AS STRING, c AS STRING)
    ilol$ = sxor(b, sor(a, snot(c)))
END FUNCTION

FUNCTION lrotate$ (a AS STRING, b AS LONG)
    DIM c AS STRING
    c = a
    FOR i = 0 TO LEN(a) - 1
        MID$(c, i + 1) = MID$(a, (i + b) MOD LEN(a) + 1, 1)
    NEXT
    lrotate$ = c
END FUNCTION

FUNCTION r1$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
    r1$ = stadd(b, lrotate(stadd(stadd(a, flol(b, c, d)), stadd(x(k), t(i))), s))
END FUNCTION

FUNCTION r2$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
    r2$ = stadd(b, lrotate(stadd(stadd(a, glol(b, c, d)), stadd(x(k), t(i))), s))
END FUNCTION

FUNCTION r3$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
    r3$ = stadd(b, lrotate(stadd(stadd(a, hlol(b, c, d)), stadd(x(k), t(i))), s))
END FUNCTION

FUNCTION r4$ (a AS STRING, b AS STRING, c AS STRING, d AS STRING, k AS LONG, s AS LONG, i AS LONG)
    r4$ = stadd(b, lrotate(stadd(stadd(a, ilol(b, c, d)), stadd(x(k), t(i))), s))
END FUNCTION

'bitwise and
FUNCTION sand$ (a AS STRING, b AS STRING)
    DIM c AS STRING
    c = a
    FOR i = 1 TO LEN(a)
        IF (MID$(a, i, 1) = "1") AND (MID$(b, i, 1) = "1") THEN
            MID$(c, i) = "1"
        ELSE
            MID$(c, i) = "0"
        END IF
    NEXT
    sand$ = c

END FUNCTION

'bitwise not
FUNCTION snot$ (a AS STRING)
    DIM b AS STRING
    b = a
    FOR i = 1 TO LEN(a)
        IF MID$(a, i, 1) = "1" THEN
            MID$(b, i) = "0"
        ELSE
            MID$(b, i) = "1"
        END IF
    NEXT
    snot$ = b
END FUNCTION

'bitwise or
FUNCTION sor$ (a AS STRING, b AS STRING)
    DIM c AS STRING
    c = a
    FOR i = 1 TO LEN(a)
        IF (MID$(a, i, 1) = "1") OR (MID$(b, i, 1) = "1") THEN
            MID$(c, i) = "1"
        ELSE
            MID$(c, i) = "0"
        END IF
    NEXT
    sor$ = c
END FUNCTION

'kahden binaariluvun lisaaminen modulo 2^32
FUNCTION stadd$ (a AS STRING, b AS STRING)
    DIM c AS STRING
    c = b
    d = 0
    FOR i = LEN(a) TO 1 STEP -1
        e = 0
        IF d = 1 THEN e = e + 1
        IF MID$(a, i, 1) = "1" THEN e = e + 1
        IF MID$(b, i, 1) = "1" THEN e = e + 1
        IF e = 3 THEN MID$(c, i) = "1"
        IF e = 2 THEN
            MID$(c, i) = "0"
            d = 1
        END IF
        IF e = 1 THEN
            MID$(c, i) = "1"
            d = 0
        END IF
    NEXT
    stadd$ = c
END FUNCTION

'bitwise xor
FUNCTION sxor$ (a AS STRING, b AS STRING)
    DIM c AS STRING
    c = a
    FOR i = 1 TO LEN(a)
        IF MID$(a, i, 1) = MID$(b, i, 1) THEN
            MID$(c, i) = "0"
        ELSE
            MID$(c, i) = "1"
        END IF
    NEXT
    sxor$ = c
END FUNCTION