Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

SHA256.bas

Uploader:RedakteurVolta
Datum/Zeit:29.10.2008 14:20:10

'Aus http://www.freebasic.net/forum/viewtopic.php?p=41268#41268
'Leider lässt sich das Beispiel so nicht mehr fehlerfrei kompilieren,
'daher ist es geändert und etwas optimiert.
'fbc -s console "SHA256.bas"

''  SHA 256 C code taken from wikiPedia article

''  private structure for SHA
Type SHA256
  As UByte buff(64 - 1)  '' buffer, digest when full
  As UInteger h(8 - 1)   '' state variable of digest
  As ULongInt length     '' number of bytes in digest
  As Short next_         '' next buffer available
End Type

''2^32 times the cube root of the first 64 primes 2..311
Dim Shared As UInteger k(64 - 1) = { _
&h428a2f98, &h71374491, &hb5c0fbcf, &he9b5dba5, &h3956c25b, &h59f111f1, _
&h923f82a4, &hab1c5ed5, &hd807aa98, &h12835b01, &h243185be, &h550c7dc3, _
&h72be5d74, &h80deb1fe, &h9bdc06a7, &hc19bf174, &he49b69c1, &hefbe4786, _
&h0fc19dc6, &h240ca1cc, &h2de92c6f, &h4a7484aa, &h5cb0a9dc, &h76f988da, _
&h983e5152, &ha831c66d, &hb00327c8, &hbf597fc7, &hc6e00bf3, &hd5a79147, _
&h06ca6351, &h14292967, &h27b70a85, &h2e1b2138, &h4d2c6dfc, &h53380d13, _
&h650a7354, &h766a0abb, &h81c2c92e, &h92722c85, &ha2bfe8a1, &ha81a664b, _
&hc24b8b70, &hc76c51a3, &hd192e819, &hd6990624, &hf40e3585, &h106aa070, _
&h19a4c116, &h1e376c08, &h2748774c, &h34b0bcb5, &h391c0cb3, &h4ed8aa4a, _
&h5b9cca4f, &h682e6ff3, &h748f82ee, &h78a5636f, &h84c87814, &h8cc70208, _
&h90befffa, &ha4506ceb, &hbef9a3f7, &hc67178f2 }

''   store 64 bit integer
Sub putlonglong (ByVal what As ULongInt, ByVal where As UByte Ptr)
  '*where = what Shr 56 : where += 1
  '*where = what Shr 48 : where += 1
  '*where = what Shr 40 : where += 1
  '*where = what Shr 32 : where += 1
  '*where = what Shr 24 : where += 1
  '*where = what Shr 16 : where += 1
  '*where = what Shr 8 : where += 1
  '*where = what : where += 1
  Asm
    mov eax, [what]
    bswap eax
    mov ebx, [where]
    mov [ebx+4], eax
    mov eax, [what+4]
    bswap eax
    mov [ebx], eax
  End Asm
End Sub

''   store 32 bit integer
Sub putlong (ByVal what As UInteger, ByVal where As UByte Ptr)
  '*where = what Shr 24 : where += 1
  '*where = what Shr 16 : where += 1
  '*where = what Shr 8 : where += 1
  '*where = what : where += 1
  Asm
    mov eax, [what]
    bswap eax
    mov ebx, [where]
    mov [ebx], eax
  End Asm
End Sub

''   retrieve 32 bit integer
Function getlong (ByVal where As UByte Ptr) As UInteger
  'Dim As Uinteger ans
  'ans = *where Shl 24 : where += 1
  'ans Or= *where Shl 16 : where += 1
  'ans Or= *where Shl 8 : where += 1
  'ans Or= *where : where += 1
  'Return ans
  Asm
    mov ebx, [where]
    mov eax, [ebx]
    bswap eax
    mov [Function], eax
  End Asm
End Function

''   right rotate bits
Function rotate (ByVal what As UInteger, ByVal bits As Integer) As UInteger
  'Return (what Shr bits) Or (what Shl (32 - bits))
  Asm
    mov ecx, [bits]
    mov eax, [what]
    Ror eax, cl
    mov [Function], eax
  End Asm
End Function

''   start new SHA run
Sub sha256_begin (ByVal sha As SHA256 Ptr)
  sha->length = 0
  sha->next_ = 0

  '' 2^32 times the square root of the first 8 primes 2..19
  sha->h(0) = &h6a09e667
  sha->h(1) = &hbb67ae85
  sha->h(2) = &h3c6ef372
  sha->h(3) = &ha54ff53a
  sha->h(4) = &h510e527f
  sha->h(5) = &h9b05688c
  sha->h(6) = &h1f83d9ab
  sha->h(7) = &h5be0cd19
End Sub

''   digest SHA buffer contents
''   to state variable
Sub sha256_digest (ByVal sha As SHA256 Ptr)
  Dim As UInteger nxt, s0, s1, maj, t0, t1, ch
  Dim As UInteger a,b,c,d,e,f,g,h
  Dim As UInteger w(64)
  Dim As Short i

  sha->next_ = 0

  For i = 0 To 16 - 1
    w(i) = getlong (@sha->buff(0) + i * SizeOf(UInteger))
  Next

  For i = 16 To 64 - 1
    s0 = rotate(w(i-15), 7) Xor rotate(w(i-15), 18) Xor (w(i-15) shr 3)
    s1 = rotate(w(i-2), 17) Xor rotate(w(i-2), 19)  Xor (w(i-2) shr 10)
    w(i) = w(i-16) + s0 + w(i-7) + s1
  Next

  a = sha->h(0)
  b = sha->h(1)
  c = sha->h(2)
  d = sha->h(3)
  e = sha->h(4)
  f = sha->h(5)
  g = sha->h(6)
  h = sha->h(7)

  For i = 0 To 64 - 1
    s0 = rotate (a, 2) Xor rotate (a, 13) Xor rotate (a, 22)
    maj = (a And b) Xor (b And c) Xor (c And a)
    t0 = s0 + maj
    s1 = rotate (e, 6) Xor rotate (e, 11) Xor rotate (e, 25)
    ch = (e And f) Xor (Not e And g)
    t1 = h + s1 + ch + k(i) + w(i)

    h = g
    g = f
    f = e
    e = d + t1
    d = c
    c = b
    b = a
    a = t0 + t1
  Next

  sha->h(0) += a
  sha->h(1) += b
  sha->h(2) += c
  sha->h(3) += d
  sha->h(4) += e
  sha->h(5) += f
  sha->h(6) += g
  sha->h(7) += h
End Sub

''   add to current SHA buffer
''   digest when full
Sub sha256_next (ByVal sha As SHA256 Ptr, ByVal what As UByte Ptr, ByVal len_ As Short)
  Do While len_
    len_ -= 1
    sha->length += 1
    sha->buff(sha->next_) = *what : what += 1
    sha->next_ += 1
    If (sha->next_ = 64) Then
      sha256_digest (sha)
    End If
  Loop
End Sub

''   finish SHA run, output 256 bit result
Sub sha256_finish (ByVal sha As SHA256 Ptr, ByVal out_ As UByte Ptr)
  Dim As Short idx

  '' trailing bit pad
  sha->buff(sha->next_) = &h80

  sha->next_ += 1
  If (sha->next_ = 64) Then
    sha256_digest (sha)
  End If

  '' pad with zeroes until almost full
  '' leaving room for length, below
  Do While (sha->next_ <> 448/8)
    sha->buff(sha->next_) = 0
    sha->next_ += 1
    If (sha->next_ = 64) Then
      sha256_digest (sha)
    End If
  Loop

  '' n.b. length doesn't include padding from above
  putlonglong (sha->length * 8, @sha->buff(0) + 56)'448/8)
  sha->next_ += SizeOf(ULongInt)   '' must be full now

  sha256_digest (sha)

  '' output the result, big endian
  For idx = 0 To 8 - 1
    putlong (sha->h(idx), out_ + idx * SizeOf(UInteger))
  Next
End Sub



' these are the standard FIPS-180-3 test vectors
 Dim Shared As ZString Ptr msg(2) = { @"abc", _
@"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", _
@""}

Dim Shared As ZString Ptr val_(2) = { _
@"ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad", _
@"248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1", _
@"cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0"}

#Include "crt.bi"

Function main( ) As Short
  Dim As UByte  sha256sum(32 - 1)
  Dim As UByte  buf(1000 - 1)
  Dim As Byte  output_(65 - 1)
  Dim As SHA256  sha
  Dim As integer i, j

  Print Chr(10) & " SHA-256 Validation Tests:" & Chr(10, 10);
  memset (@buf(0), Asc("a"), 1000)

  For i = 0 To 3 - 1
    Print " Test " & i + 1 & " ";
    sha256_begin (@sha)

    If (i < 2) Then
      sha256_next (@sha, msg(i), Len(*msg(i)))
    Else
      For j = 0 To 1000 - 1
        sha256_next (@sha, @buf(0), 1000)
      Next
    End If

    sha256_finish (@sha, @sha256sum(0))

    For j = 0 To 32 - 1
      Dim As String*3 temp = LCase(Hex(sha256sum(j), 2))
      memcpy (@output_(0) + j * 2, @temp, 2)
    Next

    If (memcmp(@output_(0), val_(i), 64)) Then
      Print "failed!" & Chr(10);
      Return 1
    End If

    Print "passed." & Chr(10);
  Next

  Print Chr(10);
  Return 0
End Function

main
Sleep