Sha-256 QB

General FreeBASIC programming questions.
Julcar
Posts: 141
Joined: Oct 19, 2010 18:52
Contact:

Sha-256 QB

Post by Julcar »

Hi folks, I made this code for SHA-256 hash calculation in QB language

It is based on the official RFC memorandum (https://tools.ietf.org/html/rfc6234) and some others C and BASIC examples around the net

Code: Select all

'SHA-256

OPTION EXPLICIT

FUNCTION SHL(x, n)
  SHL = x * 2 ^ n
END FUNCTION

FUNCTION SHR(x, n)
  SHR = x \ 2 ^ n
END FUNCTION

FUNCTION ROTL(x, n)
 ROTL = SHL(x, n) OR SHR(x, 32 - n)
END FUNCTION

FUNCTION ROTR(x, n)
 ROTR = SHR(x, n) OR SHL(x, 32 - n)
END FUNCTION

FUNCTION CH(x, y, z)
  'CH = (x AND y) XOR ((NOT x) AND z)
  'CH = ((X And Y) Xor ((Not(X)) And z))
  CH = x AND y XOR NOT x AND z
END FUNCTION

FUNCTION MAJ(x, y, z)
  'MAJ = (x AND y) XOR (x AND z) XOR (y AND z)
  'MAJ = ((X And Y) Xor (X And z) Xor (Y And z))
  MAJ = x AND y XOR x AND z XOR y AND z
END FUNCTION

FUNCTION BSIG0(x)
  BSIG0 = ROTR(x, 2) XOR ROTR(x, 13) XOR ROTR(x, 22)
END FUNCTION

FUNCTION BSIG1(x)
  BSIG1 = ROTR(x, 6) XOR ROTR(x, 11) XOR ROTR(x, 25)
END FUNCTION

FUNCTION SSIG0(x)
  SSIG0 = ROTR(x, 7) XOR ROTR(x, 18) XOR SHR(x, 3)
END FUNCTION

FUNCTION SSIG1(x)
  SSIG1 = ROTR(x, 17) XOR ROTR(x, 19) XOR SHR(x, 10)
END FUNCTION

SUB CONSTSINIT(K())
  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

FUNCTION SHA256$(Message$)
  'Hash values
  DIM h0, h1, h2, h3, h4, h5, h6, h7
  DIM a, b, c, d, e, f, g, h, t1, t2
  'Hash constants
  DIM K(64)
  '32 bit words array
  DIM W(64)
  
  DIM DataBuffer()
  DIM MessageLen, i, t, Result$

  '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
  FOR i = 56 TO 0 STEP -8
    Message$ = Message$ + CHR$(SHR(MessageLen * 8, i))
  NEXT i
  
  CONSTSINIT(K())
  
  h0 = &H6A09E667 : h1 = &HBB67AE85 : h2 = &H3C6EF372 : h3 = &HA54FF53A
  h4 = &H510E527F : h5 = &H9B05688C : h6 = &H1F83D9AB : h7 = &H5BE0CD19
  
  'Fill the data buffer with message chars
  REDIM DataBuffer(LEN(Message$))
  FOR i = 1 TO LEN(Message$)
    DataBuffer(i) = ASC(MID$(Message$, i, 1))
  NEXT i
  
  FOR i = 0 TO LEN(Message$) \ 64 - 1
    FOR t = 0 TO 15
      W(t) = SHL(DataBuffer(t * 4), 24) OR SHL(DataBuffer((t * 4) + 1), 16) OR SHL(DataBuffer((t * 4) + 2), 8) OR DataBuffer((t * 4) +3)
    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$ = RIGHT$("0000000" + HEX$(h0), 8) + RIGHT$("0000000" + HEX$(h1), 8) + _
            RIGHT$("0000000" + HEX$(h2), 8) + RIGHT$("0000000" + HEX$(h3), 8) + _
            RIGHT$("0000000" + HEX$(h4), 8) + RIGHT$("0000000" + HEX$(h5), 8) + _
            RIGHT$("0000000" + HEX$(h6), 8) + RIGHT$("0000000" + HEX$(h7), 8)
  
  SHA256$ = LCASE$(Result$)
END FUNCTION

PRINT SHA256("abcde")
The main problem is that seems to don't work properly, hashing the string "abcde" should response
36bbe50ed96841d10443bcb670d6554f0a34b761be67ec9c4a8ad2c0c44ca42c
but instead the response is 073000008e400000c9a6000032300000c50000009b20000092000000cf600000

I made this the closests way to official specs, but I don't know where I failed.

So please give me bit of help with this

Thanks
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Sha-256 QB

Post by counting_pine »

Interesting.. Is this pure QBasic? I don't think that supported Option Explicit.

I guess probably the variables are all implicitly Single, which is 24-bit precision max.
You could make them all Long (DEFLNG A-Z). That is 32-bit, but you will probably still have problems, because:
- Long is signed, and presumably you want an unsigned SHR.
- (Even if you want a signed SHR, that's not actually the same as integer division because the latter rounds upwards for negative numbers.)
- If the SHL overflows it will cause an error.

Another alternative might be to emulate unsigned 32-bit using Doubles. To chop off the high bits, you just need to implement a mod-2^32 function. (Probably something like: 'd - int(d / 2^32) * 2^32'.)

I've had to implement bit-shifts in QB/VB before. It wasn't that pretty or fast, but it was doable. Let me know how you get on.
Julcar
Posts: 141
Joined: Oct 19, 2010 18:52
Contact:

Re: Sha-256 QB

Post by Julcar »

You were right, I must admit I am newie in this type of bit-level programming, and reading again the reference I found some errors, here is an improved version

Code: Select all

'SHA-256

OPTION EXPLICIT

FUNCTION SHL&(x AS LONG, n)
  SHL& = x * 2 ^ n
END FUNCTION

FUNCTION SHR&(x AS LONG, n)
  SHR& = x \ 2 ^ n
END FUNCTION

FUNCTION ROTL&(x AS LONG, n)
  ROTL& = SHL&(x, n) OR SHR&(x, 32 - n)
END FUNCTION

FUNCTION ROTR&(x AS LONG, n)
  ROTR& = SHR&(x, n) OR SHL&(x, 32 - n)
END FUNCTION

FUNCTION CH&(x AS LONG, y AS LONG, z AS LONG)
  'CH = (x AND y) XOR ((NOT x) AND z)
  'CH = ((X And Y) Xor ((Not(X)) And z))
  CH& = x AND y XOR NOT x AND z
END FUNCTION

FUNCTION MAJ&(x AS LONG, y AS LONG, z AS LONG)
  'MAJ = (x AND y) XOR (x AND z) XOR (y AND z)
  'MAJ = ((X And Y) Xor (X And z) Xor (Y And z))
  MAJ& = x AND y XOR x AND z XOR y AND z
END FUNCTION

FUNCTION BSIG0&(x AS LONG)
  BSIG0& = ROTR&(x, 2) XOR ROTR&(x, 13) XOR ROTR&(x, 22)
END FUNCTION

FUNCTION BSIG1&(x AS LONG)
  BSIG1& = ROTR&(x, 6) XOR ROTR&(x, 11) XOR ROTR&(x, 25)
END FUNCTION

FUNCTION SSIG0&(x AS LONG)
  SSIG0& = ROTR&(x, 7) XOR ROTR&(x, 18) XOR SHR&(x, 3)
END FUNCTION

FUNCTION SSIG1&(x AS LONG)
  SSIG1& = ROTR&(x, 17) XOR ROTR&(x, 19) XOR SHR&(x, 10)
END FUNCTION

SUB CONSTSINIT(K() AS LONG)
  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

FUNCTION SHA256$(Message$)
  'Hash values
  DIM h0&, h1&, h2&, h3&, h4&, h5&, h6&, h7&
  'Working variables
  DIM a&, b&, c&, d&, e&, f&, g&, h&, t1&, t2&
  'Hash constants
  DIM K(64) AS LONG
  '32 bit words array
  DIM W(64) AS LONG
  
  DIM DataBuffer()
  DIM MessageLen, i, t, Result$

  '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
  FOR i = 56 TO 0 STEP -8
    Message$ = Message$ + CHR$(SHR&(CLNG(MessageLen * 8), i))
  NEXT i
  
  CONSTSINIT(K())
  
  h0& = &H6A09E667 : h1& = &HBB67AE85 : h2& = &H3C6EF372 : h3& = &HA54FF53A
  h4& = &H510E527F : h5& = &H9B05688C : h6& = &H1F83D9AB : h7& = &H5BE0CD19
  
  'Fill the data buffer with message chars
  REDIM DataBuffer(LEN(Message$))
  FOR i = 1 TO LEN(Message$)
    DataBuffer(i) = ASC(MID$(Message$, i, 1))
  NEXT i
  
  FOR i = 0 TO LEN(Message$) \ 64 - 1
    FOR t = 0 TO 15
      W(t) = SHL&(CLNG(DataBuffer(t * 4)), 24) OR SHL&(CLNG(DataBuffer((t * 4) + 1)), 16) OR SHL&(CLNG(DataBuffer((t * 4) + 2)), 8) OR CLNG(DataBuffer((t * 4)) +3)
    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$ = RIGHT$("0000000" + HEX$(h0&), 8) + RIGHT$("0000000" + HEX$(h1&), 8) + _
            RIGHT$("0000000" + HEX$(h2&), 8) + RIGHT$("0000000" + HEX$(h3&), 8) + _
            RIGHT$("0000000" + HEX$(h4&), 8) + RIGHT$("0000000" + HEX$(h5&), 8) + _
            RIGHT$("0000000" + HEX$(h6&), 8) + RIGHT$("0000000" + HEX$(h7&), 8)
  
  SHA256$ = LCASE$(Result$)
END FUNCTION

PRINT SHA256("abcde")
Now the result is 0802f9534dbefa59a3484fc8e3eb5060bd8728bdcf23dade0f5d7f3f675fc88a still wrong but has more sense
Julcar
Posts: 141
Joined: Oct 19, 2010 18:52
Contact:

Re: Sha-256 QB

Post by Julcar »

counting_pine wrote:Interesting.. Is this pure QBasic? I don't think that supported Option Explicit.

I guess probably the variables are all implicitly Single, which is 24-bit precision max.
You could make them all Long (DEFLNG A-Z). That is 32-bit, but you will probably still have problems, because:
- Long is signed, and presumably you want an unsigned SHR.
- (Even if you want a signed SHR, that's not actually the same as integer division because the latter rounds upwards for negative numbers.)
- If the SHL overflows it will cause an error.

Another alternative might be to emulate unsigned 32-bit using Doubles. To chop off the high bits, you just need to implement a mod-2^32 function. (Probably something like: 'd - int(d / 2^32) * 2^32'.)

I've had to implement bit-shifts in QB/VB before. It wasn't that pretty or fast, but it was doable. Let me know how you get on.
I've made this function inspired by: http://www.tek-tips.com/viewthread.cfm?qid=747595

Code: Select all

FUNCTION ULONG32&(x AS LONG)
  DIM xDbl AS DOUBLE
  DIM y AS DOUBLE
  xDbl = CDBL(x)
  IF x < &H80000000 THEN
    y = xDbl + (2^32 + 1)
  ELSE
    y = xDbl
  END IF
  ULONG32& = CLNG(y)
END FUNCTION
Julcar
Posts: 141
Joined: Oct 19, 2010 18:52
Contact:

Re: Sha-256 QB

Post by Julcar »

Well, here is the almost complete code, but seems to be something wrong, I blame on the ULONG32 function, because all of the code except that function is based on the sha-256 reference, I need more research about doing mod 2^32 additions

Code: Select all

'SHA-256

OPTION EXPLICIT

FUNCTION SHL&(x AS LONG, n)
  SHL& = x * 2 ^ n
END FUNCTION

FUNCTION SHR&(x AS LONG, n)
  SHR& = x \ 2 ^ n
END FUNCTION

FUNCTION ROTL&(x AS LONG, n)
  ROTL& = SHL&(x, n) OR SHR&(x, 32 - n)
END FUNCTION

FUNCTION ROTR&(x AS LONG, n)
  ROTR& = SHR&(x, n) OR SHL&(x, 32 - n)
END FUNCTION

FUNCTION CH&(x AS LONG, y AS LONG, z AS LONG)
  CH& = (x AND y) XOR ((NOT x) AND z)
END FUNCTION

FUNCTION MAJ&(x AS LONG, y AS LONG, z AS LONG)
  MAJ& = (x AND y) XOR (x AND z) XOR (y AND z)
END FUNCTION

FUNCTION BSIG0&(x AS LONG)
  BSIG0& = ROTR&(x, 2) XOR ROTR&(x, 13) XOR ROTR&(x, 22)
END FUNCTION

FUNCTION BSIG1&(x AS LONG)
  BSIG1& = ROTR&(x, 6) XOR ROTR&(x, 11) XOR ROTR&(x, 25)
END FUNCTION

FUNCTION SSIG0&(x AS LONG)
  SSIG0& = ROTR&(x, 7) XOR ROTR&(x, 18) XOR SHR&(x, 3)
END FUNCTION

FUNCTION SSIG1&(x AS LONG)
  SSIG1& = ROTR&(x, 17) XOR ROTR&(x, 19) XOR SHR&(x, 10)
END FUNCTION

FUNCTION ULONG32&(x AS LONG)
  DIM xDbl AS DOUBLE
  DIM y AS DOUBLE
  xDbl = CDBL(x)
  IF x < &H80000000 THEN
    y = xDbl + (2^32 + 1)
  ELSE
    y = xDbl
  END IF
  ULONG32& = CLNG(y)
END FUNCTION

SUB CONSTSINIT(K() AS LONG)
  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

FUNCTION SHA256$(Message$)
  'Hash values
  DIM h0&, h1&, h2&, h3&, h4&, h5&, h6&, h7&
  'Working variables
  DIM a&, b&, c&, d&, e&, f&, g&, h&, t1&, t2&
  'Hash constants
  DIM K(64) AS LONG
  '32 bit words array
  DIM W(64) AS LONG
  
  DIM MessageLen&, chunk, i, t, Result$

  'Save message length in bits before padding
  MessageLen& = LEN(Message$) * 8
  
  '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
  FOR i = 56 TO 0 STEP -8
    Message$ = Message$ + CHR$(SHR&(MessageLen&, i))
  NEXT i
  
  'Initialize constants
  CONSTSINIT(K())
  
  'Load hash values
  h0& = &H6A09E667 : h1& = &HBB67AE85 : h2& = &H3C6EF372 : h3& = &HA54FF53A
  h4& = &H510E527F : h5& = &H9B05688C : h6& = &H1F83D9AB : h7& = &H5BE0CD19
  
  'Break message into 512-bit (64 bytes) chunks
  FOR chunk = 0 TO LEN(Message$) \ 64 - 1
  
    'Split each chunk into 16 32-bit words
    FOR t = 1 TO 64 STEP 4
      'Get words as big-endian
      W(t \ 4) = SHL&(ASC(MID$(Message$, t, 1)), 24) OR SHL&(ASC(MID$(Message$, t + 1, 1)), 16) OR SHL&(ASC(MID$(Message$, t + 2, 1)), 8) OR ASC(MID$(Message$, t + 3, 1))
    NEXT t
    
    FOR t = 16 TO 63
      W(t) = ULONG32&(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& = ULONG32&(h& + BSIG1&(e&) + CH&(e&, f&, g&) + K(t) + W(t))
      t2& = ULONG32&(BSIG0&(a&) + MAJ&(a&, b& ,c&))
      h& = g&
      g& = f&
      f& = e&
      e& = ULONG32&(d& + t1&)
      d& = c&
      c& = b&
      b& = a&
      a& = ULONG32&(t1& + t2&)
    NEXT t
    
    h0& = ULONG32&(h0& + a&)
    h1& = ULONG32&(h1& + b&)
    h2& = ULONG32&(h2& + c&)
    h3& = ULONG32&(h3& + d&)
    h4& = ULONG32&(h4& + e&)
    h5& = ULONG32&(h5& + f&)
    h6& = ULONG32&(h6& + g&)
    h7& = ULONG32&(h7& + h&)
  NEXT chunk
  
  Result$ = RIGHT$("0000000" + HEX$(h0&), 8) + RIGHT$("0000000" + HEX$(h1&), 8) + _
            RIGHT$("0000000" + HEX$(h2&), 8) + RIGHT$("0000000" + HEX$(h3&), 8) + _
            RIGHT$("0000000" + HEX$(h4&), 8) + RIGHT$("0000000" + HEX$(h5&), 8) + _
            RIGHT$("0000000" + HEX$(h6&), 8) + RIGHT$("0000000" + HEX$(h7&), 8)
  
  SHA256$ = LCASE$(Result$)
END FUNCTION

PRINT SHA256("abcde")
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Sha-256 QB

Post by counting_pine »

The ULONG32& function does not change the variable, because 'x < &h80000000' (i.e. 'x < -2147483648') is always false.
Even if it did work, the return type ('&' = Long) is signed, so it won't store the full range of unsigned values.
You would need to use a Double to store the value exactly, although it is a little overkill.

Code: Select all

function unsigned#(n as long)
  unsigned = n - 2# * (n and &h80000000)
end function

function signed&(n as double)
  if n <= &h7fffffff then
    signed = n
  else
    signed = n - 4294967296#
  end if
end function

function shr&(x as long, n as integer)
  shr = signed(int(unsigned(x) / 2^n))
end function
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Sha-256 QB

Post by counting_pine »

By the way, converting an "unsigned" Integer to Long is easier than shown there - you just take 'x AND 65535'.
But it only works because a 32-bit signed Long (31 bits when positive) can easily hold a 16-bit signed Integer.
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: Sha-256 QB

Post by frisian »

I don't have at this moment time to give a explanation of the changes I made but it should not be hard to spot them.
The extra code makes the program slow but there is room for some speedup.

Code: Select all

'SHA-256

OPTION EXPLICIT

FUNCTION SHL&(x AS LONG, n)
  ' SHL& = x * 2 ^ n
  DIM x1 AS DOUBLE
  IF x < 0 THEN x1 = x + 2^32 ELSE x1 = x
  x1 = x1 * 2 ^ n
  WHILE x1 > &h7fffffff
    x1 = x1 - 2^32
  WEND
  SHL& = x1
END FUNCTION

FUNCTION SHR&(x AS LONG, n)
  'SHR& = x \ 2 ^ n
  DIM x1 AS DOUBLE
  IF x < 0 THEN x1 = x + 2^32 ELSE x1 = x
  x1 = x1 / 2 ^ n
  SHR& = INT(x1)
END FUNCTION

FUNCTION ROTL&(x AS LONG, n)
  ROTL& = SHL&(x, n) OR SHR&(x, 32 - n)
END FUNCTION

FUNCTION ROTR&(x AS LONG, n)
  ROTR& = SHR&(x, n) OR SHL&(x, 32 - n)
END FUNCTION

FUNCTION CH&(x AS LONG, y AS LONG, z AS LONG)
  CH& = (x AND y) XOR ((NOT x) AND z)
END FUNCTION

FUNCTION MAJ&(x AS LONG, y AS LONG, z AS LONG)
  MAJ& = (x AND y) XOR (x AND z) XOR (y AND z)
END FUNCTION

FUNCTION BSIG0&(x AS LONG)
  BSIG0& = ROTR&(x, 2) XOR ROTR&(x, 13) XOR ROTR&(x, 22)
END FUNCTION

FUNCTION BSIG1&(x AS LONG)
  BSIG1& = (ROTR&(x, 6) XOR ROTR&(x, 11)) XOR ROTR&(x, 25)
END FUNCTION

FUNCTION SSIG0&(x AS LONG)
  SSIG0& = ROTR&(x, 7) XOR ROTR&(x, 18) XOR SHR&(x, 3)
END FUNCTION

FUNCTION SSIG1&(x AS LONG)
  SSIG1& = ROTR&(x, 17) XOR ROTR&(x, 19) XOR SHR&(x, 10)
END FUNCTION

'FUNCTION ULONG32&(x AS LONG)
'  DIM xDbl AS DOUBLE
'  DIM y AS DOUBLE
'  xDbl = CDBL(x)
'  IF x < &H80000000 THEN
'    y = xDbl + (2^32 + 1)
'  ELSE
'    y = xDbl
'  END IF
'  ULONG32& = CLNG(y)
'END FUNCTION

FUNCTION ULONG32&(a AS LONG, b AS LONG, c AS LONG, d AS LONG, e AS LONG)
  DIM AS DOUBLE a1, a2, a3, a4, a5, sum
  IF a < 0 THEN a1 = a + 2^32 ELSE a1 = a
  IF b < 0 THEN a2 = b + 2^32 ELSE a2 = b
  IF c < 0 THEN a3 = c + 2^32 ELSE a3 = c
  IF d < 0 THEN a4 = d + 2^32 ELSE a4 = d
  IF e < 0 THEN a5 = e + 2^32 ELSE a5 = e
  sum = a1 + a2 + a3 + a4 + a5
  WHILE sum > &H7fffffff
    sum = sum - 2^32
  WEND
  ULONG32& = sum
END FUNCTION

SUB CONSTSINIT(K() AS LONG)
  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) = &H0FC19DC6 : 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) = &H06CA6351 : 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

FUNCTION SHA256$(Message$)
  'Hash values
  DIM h0&, h1&, h2&, h3&, h4&, h5&, h6&, h7&
  'Working variables
  DIM a&, b&, c&, d&, e&, f&, g&, h&, t1&, t2&
  'Hash constants
  DIM K(64) AS LONG
  '32 bit words array
  DIM W(64) AS LONG

  DIM MessageLen&, chunk, i, t, Result$

  'Save message length in bits before padding
  MessageLen& = LEN(Message$) * 8

  '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
  FOR i = 56 TO 0 STEP -8
    Message$ = Message$ + CHR$(SHR&(MessageLen&, i))
  NEXT i

  'Initialize constants
  CONSTSINIT(K())

  'Load hash values
  h0& = &H6A09E667 : h1& = &HBB67AE85 : h2& = &H3C6EF372 : h3& = &HA54FF53A
  h4& = &H510E527F : h5& = &H9B05688C : h6& = &H1F83D9AB : h7& = &H5BE0CD19

  'Break message into 512-bit (64 bytes) chunks
  FOR chunk = 0 TO LEN(Message$) \ 64 -1

    'Split each chunk into 16 32-bit words
    FOR t = 1 TO 64 STEP 4
      'Get words as big-endian
      W(t \ 4) = SHL&(ASC(MID$(Message$, t, 1)), 24) OR SHL&(ASC(MID$(Message$, t + 1, 1)), 16) OR SHL&(ASC(MID$(Message$, t + 2, 1)), 8) OR ASC(MID$(Message$, t + 3, 1))
    NEXT t

    FOR t = 16 TO 63
      ' W(t) = ULONG32&(SSIG1&(W(t - 2)) + W(t - 7) + SSIG0&(W(t - 15)) + W(t - 16))
      W(t) = ULONG32&(SSIG1&(W(t - 2)), W(t - 7), SSIG0&(W(t - 15)), W(t - 16), 0)
    NEXT t

    a& = h0& : b& = h1& : c& = h2& : d& = h3&
    e& = h4& : f& = h5& : g& = h6& : h& = h7&

    FOR t = 0 TO 63
      PRINT USING "####"; t;  'progress indicater
      't1& = ULONG32&(h& + BSIG1&(e&) + CH&(e&, f&, g&) + K(t) + W(t))
      't2& = ULONG32&(BSIG0&(a&) + MAJ&(a&, b& ,c&))
      t1& = ULONG32&(h&, BSIG1&(e&), CH&(e&, f&, g&), K(t), W(t))
      t2& = ULONG32&(BSIG0&(a&), MAJ&(a&, b& ,c&), 0, 0, 0)
      h& = g&
      g& = f&
      f& = e&
      'e& = ULONG32&(d& + t1&)
      e& = ULONG32&(d&, t1&, 0, 0, 0)
      d& = c&
      c& = b&
      b& = a&
      'a& = ULONG32&(t1& + t2&)
      a& = ULONG32&(t1&, t2&, 0, 0, 0)
    NEXT t

    'h0& = ULONG32&(h0& + a&)
    'h1& = ULONG32&(h1& + b&)
    'h2& = ULONG32&(h2& + c&)
    'h3& = ULONG32&(h3& + d&)
    'h4& = ULONG32&(h4& + e&)
    'h5& = ULONG32&(h5& + f&)
    'h6& = ULONG32&(h6& + g&)
    'h7& = ULONG32&(h7& + h&)

    h0& = ULONG32&(h0&, a&, 0, 0, 0)
    h1& = ULONG32&(h1&, b&, 0, 0, 0)
    h2& = ULONG32&(h2&, c&, 0, 0, 0)
    h3& = ULONG32&(h3&, d&, 0, 0, 0)
    h4& = ULONG32&(h4&, e&, 0, 0, 0)
    h5& = ULONG32&(h5&, f&, 0, 0, 0)
    h6& = ULONG32&(h6&, g&, 0, 0, 0)
    h7& = ULONG32&(h7&, h&, 0, 0, 0)

    PRINT
  NEXT chunk
  PRINT

  Result$ = RIGHT$("0000000" + HEX$(h0&), 8) + RIGHT$("0000000" + HEX$(h1&), 8) + _
            RIGHT$("0000000" + HEX$(h2&), 8) + RIGHT$("0000000" + HEX$(h3&), 8) + _
            RIGHT$("0000000" + HEX$(h4&), 8) + RIGHT$("0000000" + HEX$(h5&), 8) + _
            RIGHT$("0000000" + HEX$(h6&), 8) + RIGHT$("0000000" + HEX$(h7&), 8)

  SHA256$ = LCASE$(Result$)
END FUNCTION

PRINT SHA256("abcde")
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Sha-256 QB

Post by dodicat »

Thanks Frisian for line 112 (big endian).
I had been flapping around there for ages.
But why lang "qb"?
It is faster in lang fb.

Code: Select all

#include "crt.bi"

Function _SHL(x As Ulong, n As Ulong) As  Ulong
    If n>31 Then Exit Function
    Return x Shl n
End Function

Function _SHR(x As Ulong, n As Ulong) As  Ulong
    If n>31 Then Exit Function
    Return x Shr n
End Function

Function ROTL(x As Ulong, n As Ulong) As  Ulong
    Return _lrotl(x,n)
End Function

Function ROTR(x As Ulong, n As Ulong) As  Ulong
    Return _lrotr(x,n) 
End Function

Function CH_(x As Ulong, y As Ulong, z As Ulong) As  Ulong
    Return x And y XOR Not x And z
End Function

Function MAJ(x As Ulong, y As Ulong, z As Ulong) As  Ulong
    Return x And y XOR x And z XOR y And z
End Function

Function BSIG0(x As Ulong) As  Ulong
    Return ROTR(x, 2) XOR ROTR(x, 13) XOR ROTR(x, 22)
End Function

Function BSIG1(x As Ulong) As  Ulong
    Return ROTR(x, 6) XOR ROTR(x, 11) XOR ROTR(x, 25)
End Function

Function SSIG0(x As Ulong) As  Ulong
    Return ROTR(x, 7) XOR ROTR(x, 18) XOR _SHR(x, 3)
End Function

Function SSIG1(x As Ulong) As  Ulong
    Return ROTR(x, 17) XOR ROTR(x, 19) XOR _SHR(x, 10)
End Function

Sub CONSTSINIT(K() As Ulong) 
    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

Function SHA256(Message As String) As String
    '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(64) As Ulong
    '32 bit words array
    Dim W(64) As Ulong
    
    Dim DataBuffer() As Ulong,result As String
    Dim As Ulong MessageLen, i, t', Result$
    
    '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)
        ' print len(message) 
    Wend
    
    'Add message length to final right padding
    For i As Long = 56 To 0 Step -8
        Message = Message + Chr(_SHR(MessageLen * 8, i))
        'print len(message),i  mod 33,i
    Next i
    
    CONSTSINIT(K())
    
    h0 = &H6A09E667 : h1 = &HBB67AE85 : h2 = &H3C6EF372 : h3 = &HA54FF53A
    h4 = &H510E527F : h5 = &H9B05688C : h6 = &H1F83D9AB : h7 = &H5BE0CD19
    
    'Fill the data buffer with message chars
    Redim DataBuffer(Len(Message))
    For i = 1 To Len(Message)
        DataBuffer(i) = Asc(Mid(Message, i, 1))
    Next i
    
    For i  = 0 To Len(Message) \ 64 -1
        
        For t = 1 To 64 Step 4 '(BY FRISIAN)
            w(T\4)=_SHL(Asc(Mid(Message, t, 1)), 24) Or _SHL(Asc(Mid(Message, t + 1, 1)), 16) Or _SHL(Asc(Mid(Message, t + 2, 1)), 8) Or Asc(Mid(Message, t + 3, 1))
            ' W(t\4) = _SHL(DataBuffer(t * 4), 24) OR _SHL(DataBuffer((t * 4) + 1), 16) OR _SHL(DataBuffer((t * 4) + 2), 8) OR DataBuffer((t * 4) +3)
        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 =  Right("0000000" + Hex(h0), 8) + Right("0000000" + Hex(h1), 8) + _
    Right("0000000" + Hex(h2), 8) + Right("0000000" + Hex(h3), 8) + _
    Right("0000000" + Hex(h4), 8) + Right("0000000" + Hex(h5), 8) + _
    Right("0000000" + Hex(h6), 8) + Right("0000000" + Hex(h7), 8)
    
    SHA256 = Lcase(Result)
    
End Function
Print SHA256("abcde")

Print SHA256("freebasic")

Sleep 
Julcar
Posts: 141
Joined: Oct 19, 2010 18:52
Contact:

Re: Sha-256 QB

Post by Julcar »

dodicat wrote:Thanks Frisian for line 112 (big endian).
I had been flapping around there for ages.
But why lang "qb"?
It is faster in lang fb.
just btw, the big endian line is mine (see http://freebasic.net/forum/viewtopic.ph ... ad#p236174)

now, respect to the language, My project code is in -lang qb (is more easier for me)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Sha-256 QB

Post by dodicat »

Sorry about the endian.
For lang qb perhaps:

Code: Select all

#lang "qb"

Function _SHL(x As __Ulong, n As __Ulong) As  __Ulong
    If n>31 Then Exit Function
    _SHL=  x __Shl n
End Function

Function _SHR(x As __Ulong, n As __Ulong) As  __Ulong
    If n>31 Then Exit Function
    _SHR = x __Shr n
End Function

FUNCTION ROTL(x AS __Ulong, n as __Ulong) as __Ulong
  ROTL = (x __shl n) OR (x __shr (32 - n))
END FUNCTION

FUNCTION ROTR(x AS __Ulong, n as __Ulong) as __Ulong
  ROTR = (x __shr n) OR (x __shl (32 - n))
END FUNCTION

Function CH_(x As __Ulong, y As __Ulong, z As __Ulong) As  __Ulong
    CH_= x And y XOR Not x And z
End Function

Function MAJ(x As __Ulong, y As __Ulong, z As __Ulong) As  __Ulong
    MAJ= x And y XOR x And z XOR y And z
End Function

Function BSIG0(x As __Ulong) As  __Ulong
    BSIG0= ROTR(x, 2) XOR ROTR(x, 13) XOR ROTR(x, 22)
End Function

Function BSIG1(x As __Ulong) As  __Ulong
    BSIG1= ROTR(x, 6) XOR ROTR(x, 11) XOR ROTR(x, 25)
End Function

Function SSIG0(x As __Ulong) As  __Ulong
    SSIG0= ROTR(x, 7) XOR ROTR(x, 18) XOR _SHR(x, 3)
End Function

Function SSIG1(x As __Ulong) As  __Ulong
    SSIG1= ROTR(x, 17) XOR ROTR(x, 19) XOR _SHR(x, 10)
End Function

Sub CONSTSINIT(K() As __Ulong) 
    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

Function SHA256(Message As String) As String
    '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(64) As __Ulong
    '32 bit words array
    Dim W(64) As __Ulong
    
    Dim DataBuffer() As __Ulong,result As String
    Dim As __Ulong MessageLen, i, t', Result$
    
    '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)
        ' print len(message) 
    Wend
    
    'Add message length to final right padding
    dim j as long
    For j  = 56 To 0 Step -8
       ' if j=0 then exit for
        Message = Message + Chr$(_SHR(MessageLen * 8, __culng(j)))
       ' print len(message),i  mod 33,i
    Next j
    
    CONSTSINIT(K())
    
    h0 = &H6A09E667 : h1 = &HBB67AE85 : h2 = &H3C6EF372 : h3 = &HA54FF53A
    h4 = &H510E527F : h5 = &H9B05688C : h6 = &H1F83D9AB : h7 = &H5BE0CD19
    
    'Fill the data buffer with message chars
    Redim DataBuffer(Len(Message))
    For i = 1 To Len(Message)
        DataBuffer(i) = Asc(Mid$(Message, i, 1))
    Next i
    
    For i  = 0 To Len(Message) \ 64 -1
        For t = 1 To 64 Step 4 '(BY FRISIAN)
            w(T\4)=_SHL(Asc(Mid$(Message, t, 1)), 24) Or _SHL(Asc(Mid$(Message, t + 1, 1)), 16) Or _SHL(Asc(Mid$(Message, t + 2, 1)), 8) Or Asc(Mid$(Message, t + 3, 1))
            ' W(t\4) = _SHL(DataBuffer(t * 4), 24) OR _SHL(DataBuffer((t * 4) + 1), 16) OR _SHL(DataBuffer((t * 4) + 2), 8) OR DataBuffer((t * 4) +3)
        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 =  Right$("0000000" + Hex$(h0), 8) + Right$("0000000" + Hex$(h1), 8) + _
          Right$("0000000" + Hex$(h2), 8) + Right$("0000000" + Hex$(h3), 8) + _
          Right$("0000000" + Hex$(h4), 8) + Right$("0000000" + Hex$(h5), 8) + _
          Right$("0000000" + Hex$(h6), 8) + Right$("0000000" + Hex$(h7), 8)
    
    SHA256 = Lcase$(Result)
    
End Function
Print SHA256("abcde")

Print SHA256("freebasic")

Sleep 
Seems OK on Win 10 32 and 64 bits.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: Sha-256 QB

Post by srvaldez »

hello dodicat
in your code in previous posts I get
sha-256.bas(14) error 41: Variable not declared, _lrotl in 'Return _lrotl(x,n)'
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Sha-256 QB

Post by dodicat »

Hi srvaldez
The rotate functions are in crt.bi

You can use both functions from the lang qb code instead.
Just rub out the underscores.

My system

FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.05.0
both 32 and 64 bit.
(I wonder why you get the error?)
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: Sha-256 QB

Post by srvaldez »

dodicat wrote: (I wonder why you get the error?)
I was compiling on my mac, therefore the symbol was not found, normally I have no problems with programs that use crt.
thank you dodicat.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Sha-256 QB

Post by dodicat »

I converted all the qb functions to macros.
And compiled with -pp
(-pp does not output #lang "qb" code correctly)
So, after a few corrections, here is a self contained ~lang "qb" sha-256 function made by Julcar

Code: Select all

#lang "qb"


Function SHA256(byval Message As String) As String
 Dim As __Ulong h0, h1, h2, h3, h4, h5, h6, h7
 Dim As __Ulong a, b, c, d, e, f, g, h, t1, t2
 Dim K(64) As __Ulong
 Dim W(64) As __Ulong
 Dim DataBuffer() As __Ulong,result As String
 Dim As __Ulong MessageLen, i, t
 MessageLen = Len(Message)
 Message = Message +chr$(Val("&H80"))

 While(Len(Message) Mod 64) <> 56
 Message = Message+ chr$(0)
 Wend

 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

 Redim DataBuffer(Len(Message))
 For i = 1 To Len(Message)
 DataBuffer(i) = Asc(mid$(Message, i, 1))
 Next i

 For i = 0 To Len(Message) \ 64 -1
 For t = 1 To 64 Step 4
 w(T\4)= (Asc(mid$(Message, t, 1))) __Shl (24) and (24)<32 Or (Asc(mid$(Message, t + 1, 1))) __Shl (16) and (16)<32 Or (Asc(mid$(Message, t + 2, 1))) __Shl (8) and (8)<32 Or Asc(mid$(Message, t + 3, 1))
 Next t
 For t = 16 To 63
 W(t) = (((W(t -2)) __Shr 17 Or (W(t -2)) __Shl 15) Xor ((W(t -2)) __Shr 19 Or (W(t -2)) __Shl 13) Xor ((W(t -2)) __Shr 10)) + W(t - 7) + (((W(t -15)) __Shr 7 Or (W(t -15)) __Shl 25) Xor ((W(t -15)) __Shr 18 Or (W(t -15)) __Shl 14) Xor ((W(t -15)) __Shr 3)) + 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 + (((e) __Shr 6 Or (e) __Shl 26) Xor ((e) __Shr 11 Or (e) __Shl 21) Xor ((e) __Shr 25 Or (e) __Shl 7)) + (((e) And (f)) Xor ((Not (e)) And g)) + K(t) + W(t)
 t2 = (((a) __Shr 2 Or (a) __Shl 30) Xor ((a) __Shr 13 Or (a) __Shl 19) Xor ((a) __Shr 22 Or (a) __Shl 10)) + (((a) And (b)) Xor ((a) And (c)) Xor ((b) And (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 =  Right$("0000000" + Hex$(h0), 8) + Right$("0000000" + Hex$(h1), 8) + _
          Right$("0000000" + Hex$(h2), 8) + Right$("0000000" + Hex$(h3), 8) + _
          Right$("0000000" + Hex$(h4), 8) + Right$("0000000" + Hex$(h5), 8) + _
          Right$("0000000" + Hex$(h6), 8) + Right$("0000000" + Hex$(h7), 8)
    SHA256 = Lcase$(Result)
End Function
Print SHA256("abcde")

Print SHA256("freebasic")

Sleep
 
Post Reply