Sha-256 QB

General FreeBASIC programming questions.
dodicat
Posts: 4340
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Sha-256 QB

Postby dodicat » Sep 13, 2017 19:03

Here is a qb md5 (got bits and pieces and ideas from WIKI / Rosettacode)
EDIT: included a sha-256 for qb (by Julcar) with macros instead of functions
md5 and sha-256 are each self contained procedures.

Code: Select all


'original sha-256 code by Julcar, with functions  expressed as macros.
'the md5 code is from wiki and rosetta code combined.
'====================== md5 =================================
#lang "qb"

'optional for lang fb
#ifdef __FB_LANG__
  #if __FB_LANG__ = "fb"
    #define __ulong ulong
    #define __shl shl
    #define __ubyte ubyte
    #define __ptr ptr
    #define __cast cast
    #define __shr shr
    #define __cptr cptr
  #endif
  #endif

 
 function md5(byval msg as string) as string
#define rotl(x,n)  (x) __Shl (n) + (x) __Shr (32 - (n))
    dim as __ulong  i
    dim as __ulong s(63)
s(0)=7:s(1)=12:s(2)=17:s(3)=22:s(4)=7:s(5)=12:s(6)=17:s(7)=22:s(8)=7:s(9)=12:s(10)=17:s(11)=22:s(12)=7:s(13)= 12:s(14)= 17:s(15)=22:  _
s(16)=5:s(17)=9:s(18)=14:s(19)=20:s(20)=5:s(21)=9:s(22)=14:s(23)=20:s(24)=5:s(25)=9:s(26)=14:s(27)=20:s(28)=5:s(29)=9:s(30)=14:s(31)=20: _
s(32)=4:s(33)=11:s(34)=16:s(35)=23:s(36)=4:s(37)=11:s(38)=16:s(39)=23:s(40)=4:s(41)=11:s(42)=16:s(43)=23:s(44)=4:s(45)=11:s(46)=16:s(47)=23: _
s(48)=6:s(49)=10:s(50)=15:s(51)=21:s(52)=6:s(53)=10:s(54)=15:s(55)=21:s(56)=6:s(57)=10:s(58)=15:s(59)=21:s(60)=6:s(61)=10:s(62)=15:s(63)=21
 
   dim as __ulong K(63)
k(0)=&hd76aa478:k(1)=&he8c7b756:k(2)=&h242070db:k(3)=&hc1bdceee : _
k(4)=&hf57c0faf:k(5)=&h4787c62a:k(6)=&ha8304613:k(7)=&hfd469501 : _
k(8)=&h698098d8:k(9)=&h8b44f7af:k(10)=&hffff5bb1:k(11)=&h895cd7be : _
k(12)= &h6b901122:k(13)=&hfd987193:k(14)=&ha679438e:k(15)=&h49b40821 : _
k(16)= &hf61e2562:k(17)=&hc040b340:k(18)=&h265e5a51:k(19)=&he9b6c7aa : _
k(20)= &hd62f105d:k(21)=&h02441453:k(22)=&hd8a1e681:k(23)=&he7d3fbc8 : _
k(24)= &h21e1cde6:k(25)=&hc33707d6:k(26)=&hf4d50d87:k(27)=&h455a14ed : _
k(28)= &ha9e3e905:k(29)=&hfcefa3f8:k(30)=&h676f02d9:k(31)=&h8d2a4c8a : _
k(32)= &hfffa3942:k(33)=&h8771f681:k(34)=&h6d9d6122:k(35)=&hfde5380c : _
k(36)=&ha4beea44:k(37)=&h4bdecfa9:k(38)=&hf6bb4b60:k(39)=&hbebfbc70 : _
k(40)=&h289b7ec6:k(41)=&heaa127fa:k(42)=&hd4ef3085:k(43)=&h04881d05 : _
k(44)= &hd9d4d039:k(45)=&he6db99e5:k(46)=&h1fa27cf8:k(47)=&hc4ac5665 : _
k(48)= &hf4292244:k(49)=&h432aff97:k(50)=&hab9423a7:k(51)=&hfc93a039 : _
k(52)= &h655b59c3:k(53)=&h8f0ccc92:k(54)=&hffeff47d:k(55)=&h85845dd1 : _
k(56)=&h6fa87e4f:k(57)=&hfe2ce6e0:k(58)=&ha3014314:k(59)=&h4e0811a1 : _
k(60)=&hf7537e82:k(61)=&hbd3af235:k(62)=&h2ad7d2bb:k(63)=&heb86d391 
 
dim as __ulong a0,b0,c0,d0,A,B,C,D
    a0 = &h67452301:A=a0 
    b0 = &hefcdab89:B=b0 
    c0 = &h98badcfe:C=c0
    d0 = &h10325476:D=d0
   Dim As __uLong  F,j,g,Temp1,temp
 
  Dim As __ULong l
  l=len(msg)
  msg = msg + Chr$(1 __Shl 7)
  Dim As __ULong Pad
  Pad = 64 - ((l +1) Mod (512 \ 8))
  If Pad < 8 Then Pad = Pad + 64
 
  msg = msg + String$(Pad, Chr$(0)) 
  Dim As __ULong Lenmsg
 Lenmsg=len(msg)
  l = l * 8   'bits
 
  For i = 0 To 7 
    msg[Lenmsg -8 + i] = __cptr(__ubyte __ptr,@l)[i]
  Next
 #macro solve
  Temp1 = D:D = C:C = B
      temp = A + F + K(i)+ ((__cptr(__ulong __ptr,@msg[j*64]))[g]) :temp= ROtl(temp, s(i))
      B = B + temp
      A = Temp1
 #endmacro
  For j = 0 To (Lenmsg -1) \ 64
    A = a0 : B = b0 : C = c0 : D = d0
 
 for i=0 to 63
 if i>=0 and i<=15 then
 F = (B And C) Or ((Not B) And D):g=i:solve:end if
 if i>15 and i<=31 then
   F = (B And D) Or (C And (Not D)):  g = (i * 5 +1) Mod 16:solve:end if
 if i>31 and i<=47 then
  F = (B Xor C Xor D): g = (i * 3 +5) Mod 16:solve:end if
 if i>47 and i<=63 then
   F = C Xor (B Or (Not D)): g = (i * 7) Mod 16:solve:end if
 next i
    a0 = a0+A : b0= b0+B : c0 =c0+C : d0 =d0+D
  Next
 
  Dim As String answer
  dim jj as long
  For jj = 7 To 1 Step -2 : answer = answer+Mid$(Hex$(a0, 8), jj, 2) : Next
  For jj = 7 To 1 Step -2 : answer = answer+Mid$(Hex$(b0, 8), jj, 2) : Next
  For jj = 7 To 1 Step -2 : answer = answer+Mid$(Hex$(c0, 8), jj, 2) : Next
  For jj = 7 To 1 Step -2 : answer = answer+Mid$(Hex$(d0, 8), jj, 2) : Next
 
  md5=  LCase$(answer)
 
end function


print "md5"
print md5("abcde")
print md5("freebasic")
print md5("")
print
print "press a key for sha-256"
sleep

 







'======================  sha-256 =====================
'optional for lang fb
#ifdef __FB_LANG__
  #if __FB_LANG__ = "fb"
    #define __ulong ulong
    #define __shl shl
    #define __shr shr
    #define __culng culng
  #endif
  #endif

Function SHA256(byval Message As String) As String

#Macro Ch_ (x, y, z)
    (((x) And (y)) Xor ((Not (x)) And z))
#EndMacro
 
#Macro Maj (x, y, z)
    (((x) And (y)) Xor ((x) And (z)) Xor ((y) And (z)))
#EndMacro
 
#Macro BSIG0(x)
 (((x) __Shr 2 Or (x) __Shl 30) Xor ((x) __Shr 13 Or (x) __Shl 19) Xor ((x) __Shr 22 Or (x) __Shl 10))
#EndMacro
 
#macro BSIG1(x)
  (((x) __Shr 6 Or (x) __Shl 26) Xor ((x) __Shr 11 Or (x) __Shl 21) Xor ((x) __Shr 25 Or (x) __Shl 7))
#endmacro

#macro SSIG0(x)
  (((x) __Shr 7 Or (x) __Shl 25) Xor ((x) __Shr 18 Or (x) __Shl 14) Xor ((x) __Shr 3))
#endmacro

#macro SSIG1(x)
  (((x) __Shr 17 Or (x) __Shl 15) Xor ((x) __Shr 19 Or (x) __Shl 13) Xor ((x) __Shr 10))
#endmacro

    'Hash values
    Dim As __Ulong h0, h1, h2, h3, h4, h5, h6, h7
    Dim As __Ulong a, b, c, d, e, f, g, h, t1, t2
    'Hash constants
    Dim K(63) As __Ulong
    '32 bit words array
    Dim W(63) As __Ulong
   
    Dim DataBuffer() As __Ulong,result As String
    Dim As __Ulong MessageLen, i, t
   
    'Save message length before padding
    MessageLen = Len(Message)
   
    'Add bit 1 to right padding
    Message = Message +Chr$(Val("&H80"))
   
    'Add padding zeroes
    While(Len(Message) Mod 64) <> 56
        Message = Message+ Chr$(0)
    Wend
   
    'Add message length to final right padding
    dim j as long
    For j  = 56 To 0 Step -8
    Message = Message + Chr$( (MessageLen * 8) __shr  __culng(j) and  __culng(j)<32 )
    Next j

    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
   
    h0 = &H6A09E667 : h1 = &HBB67AE85 : h2 = &H3C6EF372 : h3 = &HA54FF53A
    h4 = &H510E527F : h5 = &H9B05688C : h6 = &H1F83D9AB : h7 = &H5BE0CD19
   
    For i  = 0 To Len(Message) \ 64 -1
        For t = 1 To 64 Step 4
        w(T\4)=__culng(message[t-1])__shl 24 or __culng(message[t])__shl 16 or __culng(message[t+1])__shl 8 or __culng(message[t+2])
        Next t
        For t = 16 To 63
            W(t) = SSIG1(W(t-2)) + W(t-7) + SSIG0(W(t-15)) + W(t-16)
        Next t
       
        a = h0 : b = h1 : c = h2 : d = h3 : e = h4 : f = h5 : g = h6 : h = h7
       
        For t  = 0 To 63
            t1 = h + BSIG1(e) + CH_(e,f,g) + K(t) + W(t)
            t2 = BSIG0(a) + MAJ(a,b,c)
            h = g
            g = f
            f = e
            e = d + t1
            d = c
            c = b
            b = a
            a = t1 + t2
        Next t
        h0 = h0 + a
        h1 = h1 + b
        h2 = h2 + c
        h3 = h3 + d
        h4 = h4 + e
        h5 = h5 + f
        h6 = h6 + g
        h7 = h7 + h
    Next i
    result=hex$(h0,8)+hex$(h1,8)+hex$(h2,8)+hex$(h3,8)+hex$(h4,8)+hex$(h5,8)+hex$(h6,8)+hex$(h7,8)
    SHA256 = Lcase$(Result)
End Function
Print SHA256("abcde")

Print SHA256("freebasic")

print sha256("")

Sleep
 

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests