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