Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
MD5 Hash aus String ? (v2)
| Uploader: |  csde_rats |
| Datum/Zeit: | 21.07.2007 22:59:13 |
'
' MD5.BAS, based on MD5C.C
'
' RSA Data Security, Inc., MD5 message-digest algorithm
'
' Copyright (C) 1992, RSA Data Security, Inc. Created 1991. All
' rights reserved.
'
' License to copy and use this software is granted provided that it
' is identified as the "RSA Data Security, Inc. MD5 Message-Digest
' Algorithm" in all material mentioning or referencing this software
' or this function.
'
' License is also granted to make and use derivative works provided
' that such works are identified as "derived from the RSA Data
' Security, Inc. MD5 Message-Digest Algorithm" in all material
' mentioning or referencing the derived work.
'
' RSA Data Security, Inc. makes no representations concerning either
' the merchantability of this software or the suitability of this
' software for any particular purpose. It is provided "as is"
' without express or implied warranty of any kind.
'
' These notices must be retained in any copies of any part of this
' documentation and/or software.
'----------------------------------------------------------
#include once "crt.bi"
'----------------------------------------------------------
Dim Shared As Ubyte SEPARAT=1 'separators in result string
Dim Shared As Ubyte LOWERC=0 'lowercase
Dim Shared As Double TIMEA,TIMEB,PERF
Dim Shared As Ubyte PADDING(64) => { _
&h80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 _
}
'----------------------------------------------------------
'Constants for MD5Transform routine.
'
#define S11 7
#define S12 12
#define S13 17
#define S14 22
#define S21 5
#define S22 9
#define S23 14
#define S24 20
#define S31 4
#define S32 11
#define S33 16
#define S34 23
#define S41 6
#define S42 10
#define S43 15
#define S44 21
' POINTR defines a generic pointer type
Type POINTR As Ubyte Ptr
' UINT2 defines a two byte word
Type UINT2 As Ushort
' UINT4 defines a four byte word
Type UINT4 As Uinteger
' MD5 context
Type MD5_CTX
state(4) As UINT4 ' state (ABCD)
count(2) As UINT4 ' number of bits, modulo 2^64 (lsb first)
buffer(64) As Ubyte ' input buffer
End Type
Type FBARRAYDIM
elements As Integer
llbound As Integer
uubound As Integer
End Type
Type FBARRAY
Data As Any Ptr ' ptr + diff, must be at ofs 0!
ptrr As Any Ptr
size As Integer
element_len As Integer
dimensions As Integer
dimTB As FBARRAYDIM Ptr ' dimtb[dimensions]
End Type
'-----------------------------------------------------------
' F, G, H and I are basic MD5 functions.
'
#define F(x, y, z) (((x) And (y)) Or ((Not x) And (z)))
#define G(x, y, z) (((x) And (z)) Or ((y) And (Not z)))
#define H(x, y, z) ((x) Xor (y) Xor (z))
#define I(x, y, z) ((y) Xor ((x) Or (Not z)))
' ROTATE_LEFT rotates x left n bits.
'
#define ROTATE_LEFT(x, n) (((x) Shl (n)) Or ((x) Shr (32-(n))))
' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
'Rotation is separate from addition to prevent recomputation.
'
#define FF(a, b, c, d, x, s, ac) _
(a) += F ((b), (c), (d)) + (x) + Int(ac): _
(a) = ROTATE_LEFT ((a), (s)): _
(a) += (b)
#define GG(a, b, c, d, x, s, ac) _
(a) += G ((b), (c), (d)) + (x) + Int(ac): _
(a) = ROTATE_LEFT ((a), (s)): _
(a) += (b)
#define HH(a, b, c, d, x, s, ac) _
(a) += H ((b), (c), (d)) + (x) + Int(ac): _
(a) = ROTATE_LEFT ((a), (s)): _
(a) += (b)
#define II(a, b, c, d, x, s, ac) _
(a) += I ((b), (c), (d)) + (x) + Int(ac): _
(a) = ROTATE_LEFT ((a), (s)): _
(a) += (b)
'----------------------------------------------------------
' MD5 initialization. Begins an MD5 operation, writing a new context.
'
Sub MD5Init (context As MD5_CTX Ptr)
context->count(0) = 0:context->count(1) = 0
' Load magic initialization constants.
'
context->state(0) = &h67452301
context->state(1) = 4023233417'&hefcdab89
context->state(2) = 2562383102'&h98badcfe
context->state(3) = &h10325476
End Sub
' Encodes inpt (UINT4) into output (unsigned char). Assumes len is
' a multiple of 4.
'
Sub Encode (outpt As Ubyte Ptr, inpt As UINT4 Ptr, lenn As Uinteger) Static
Dim As Uinteger i2, j
i2 = 0: j = 0
While j < lenn
outpt[ j ] = cubyte(inpt[i2] And &hff)
outpt[j+1] = cubyte((inpt[i2] Shr 8) And &hff)
outpt[j+2] = cubyte((inpt[i2] Shr 16) And &hff)
outpt[j+3] = cubyte((inpt[i2] Shr 24) And &hff)
i2 += 1: j += 4
Wend
End Sub
' Decodes inpt (unsigned char) into outpt (UINT4). Assumes lenn is
' a multiple of 4.
'
Sub Decode (outpt As UINT4 Ptr, inpt As Ubyte Ptr, lenn As Uinteger) Static
Dim As Uinteger i2, j
i2 = 0: j = 0
While j < lenn
outpt[i2] = ( cuint( inpt[j] ) ) Or ( ( cuint(inpt[j+1]) ) Shl 8 ) Or _
( ( cuint( inpt[j+2] ) ) Shl 16 ) Or ( ( cuint( inpt[j+3] ) ) Shl 24 )
i2 += 1: j += 4
Wend
End Sub
' MD5 basic transformation. Transforms state based on block.
Sub MD5Transform (state() As UINT4, block As Ubyte Ptr) Static
Dim As UINT4 a, b, c, d, x(16)
a = state( 0 )
b = state( 1 )
c = state( 2 )
d = state( 3 )
Decode ( @x( 0 ), block, 64)
' Round 1
FF (a, b, c, d, x( 0), S11, &hd76aa478) ' 1
FF (d, a, b, c, x( 1), S12, &he8c7b756) ' 2
FF (c, d, a, b, x( 2), S13, &h242070db) ' 3
FF (b, c, d, a, x( 3), S14, &hc1bdceee) ' 4
FF (a, b, c, d, x( 4), S11, &hf57c0faf) ' 5
FF (d, a, b, c, x( 5), S12, &h4787c62a) ' 6
FF (c, d, a, b, x( 6), S13, &ha8304613) ' 7
FF (b, c, d, a, x( 7), S14, &hfd469501) ' 8
FF (a, b, c, d, x( 8), S11, &h698098d8) ' 9
FF (d, a, b, c, x( 9), S12, &h8b44f7af) ' 10
FF (c, d, a, b, x(10), S13, &hffff5bb1) ' 11
FF (b, c, d, a, x(11), S14, &h895cd7be) ' 12
FF (a, b, c, d, x(12), S11, &h6b901122) ' 13
FF (d, a, b, c, x(13), S12, &hfd987193) ' 14
FF (c, d, a, b, x(14), S13, &ha679438e) ' 15
FF (b, c, d, a, x(15), S14, &h49b40821) ' 16
' Round 2
GG (a, b, c, d, x( 1), S21, &hf61e2562) ' 17
GG (d, a, b, c, x( 6), S22, &hc040b340) ' 18
GG (c, d, a, b, x(11), S23, &h265e5a51) ' 19
GG (b, c, d, a, x( 0), S24, &he9b6c7aa) ' 20
GG (a, b, c, d, x( 5), S21, &hd62f105d) ' 21
GG (d, a, b, c, x(10), S22, &h2441453) ' 22
GG (c, d, a, b, x(15), S23, &hd8a1e681) ' 23
GG (b, c, d, a, x( 4), S24, &he7d3fbc8) ' 24
GG (a, b, c, d, x( 9), S21, &h21e1cde6) ' 25
GG (d, a, b, c, x(14), S22, &hc33707d6) ' 26
GG (c, d, a, b, x( 3), S23, &hf4d50d87) ' 27
GG (b, c, d, a, x( 8), S24, &h455a14ed) ' 28
GG (a, b, c, d, x(13), S21, &ha9e3e905) ' 29
GG (d, a, b, c, x( 2), S22, &hfcefa3f8) ' 30
GG (c, d, a, b, x( 7), S23, &h676f02d9) ' 31
GG (b, c, d, a, x(12), S24, &h8d2a4c8a) ' 32
' Round 3
HH (a, b, c, d, x( 5), S31, &hfffa3942) ' 33
HH (d, a, b, c, x( 8), S32, &h8771f681) ' 34
HH (c, d, a, b, x(11), S33, &h6d9d6122) ' 35
HH (b, c, d, a, x(14), S34, &hfde5380c) ' 36
HH (a, b, c, d, x( 1), S31, &ha4beea44) ' 37
HH (d, a, b, c, x( 4), S32, &h4bdecfa9) ' 38
HH (c, d, a, b, x( 7), S33, &hf6bb4b60) ' 39
HH (b, c, d, a, x(10), S34, &hbebfbc70) ' 40
HH (a, b, c, d, x(13), S31, &h289b7ec6) ' 41
HH (d, a, b, c, x( 0), S32, &heaa127fa) ' 42
HH (c, d, a, b, x( 3), S33, &hd4ef3085) ' 43
HH (b, c, d, a, x( 6), S34, &h4881d05) ' 44
HH (a, b, c, d, x( 9), S31, &hd9d4d039) ' 45
HH (d, a, b, c, x(12), S32, &he6db99e5) ' 46
HH (c, d, a, b, x(15), S33, &h1fa27cf8) ' 47
HH (b, c, d, a, x( 2), S34, &hc4ac5665) ' 48
' Round 4
II (a, b, c, d, x( 0), S41, &hf4292244) ' 49
II (d, a, b, c, x( 7), S42, &h432aff97) ' 50
II (c, d, a, b, x(14), S43, &hab9423a7) ' 51
II (b, c, d, a, x( 5), S44, &hfc93a039) ' 52
II (a, b, c, d, x(12), S41, &h655b59c3) ' 53
II (d, a, b, c, x( 3), S42, &h8f0ccc92) ' 54
II (c, d, a, b, x(10), S43, &hffeff47d) ' 55
II (b, c, d, a, x( 1), S44, &h85845dd1) ' 56
II (a, b, c, d, x( 8), S41, &h6fa87e4f) ' 57
II (d, a, b, c, x(15), S42, &hfe2ce6e0) ' 58
II (c, d, a, b, x( 6), S43, &ha3014314) ' 59
II (b, c, d, a, x(13), S44, &h4e0811a1) ' 60
II (a, b, c, d, x( 4), S41, &hf7537e82) ' 61
II (d, a, b, c, x(11), S42, &hbd3af235) ' 62
II (c, d, a, b, x( 2), S43, &h2ad7d2bb) ' 63
II (b, c, d, a, x( 9), S44, &heb86d391) ' 64
state(0) += a
state(1) += b
state(2) += c
state(3) += d
' Zeroize sensitive information.
memset ( cptr( POINTR, @x( 0 ) ), 0, sizeof (x) )
End Sub
'----------------------------------------------------------
' MD5 block update operation. Continues an MD5 message-digest
' operation, processing another message block, and updating the
' context.
'
Sub MD5Update (context As MD5_CTX Ptr, inpt As Ubyte Ptr, inptLen As Uinteger)
Dim As Uinteger i2, index, partLen
' Compute number of bytes mod 64
index = cuint((context->count(0) Shr 3) And &h3F)
' Update number of bits
context->count(0) += (cuint(inptLen) Shl 3)
If context->count(0) < (cuint(inptLen) Shl 3) Then _
context->count(1)+=1
context->count(1) += (cuint(inptLen) Shr 29)
partLen = 64 - index
' Transform as many times as possible.
If (inptLen >= partLen) Then
memcpy (cptr(POINTR,@context->buffer(index)), cptr(POINTR,inpt), partLen)
MD5Transform (context->state(), @context->buffer(0))
Dim As Ubyte tmparray( 0 )
'for (i = partLen; i + 63 < inptLen; i += 64)
i2 = partLen
While i2 + 63 < inptLen
MD5Transform (context->state(), @inpt[i2])
i2 += 64
Wend
index = 0
Else
i2 = 0
End If
' Buffer remaining inpt
memcpy( cptr( POINTR, @context->buffer( index ) ), cptr( POINTR, @inpt[ i2 ] ), inptLen - i2 )
End Sub
' MD5 finalization. Ends an MD5 message-digest operation, writing the
' the message digest and zeroizing the context.
Sub MD5Final (digest() As Ubyte, context As MD5_CTX Ptr)
Dim As Ubyte bits(8)
Dim As Uinteger index, padLen
' Save number of bits
Encode ( @bits( 0 ), @context->count( 0 ), 8 )
' Pad out to 56 mod 64.
index = cuint((context->count(0) Shr 3) And &h3f)
padLen = iif(index < 56, 56 - index, 120 - index)
MD5Update (context, @PADDING( 0 ), padLen)
' Append length (before padding)
MD5Update (context, @bits( 0 ), 8)
' Store state in digest
Encode ( @digest( 0 ), @context->state( 0 ), 16)
' Zeroize sensitive information.
memset ( cptr( POINTR, context ), 0, sizeof (*context) )
End Sub
'----------------------------------------------------------
' Converts message digest to hexadecimal string
Function MD5Print (digest As Ubyte Ptr) As String
Dim As Uinteger QQ
Dim As Ubyte WW1,WW2,WW3
Dim As String OUTSTRING
outstring="":QQ=0
Do
WW1 = digest[QQ]
WW2=(WW1 Shr 4) + 48 ' 4 high bits
WW3=(WW1 And 15) + 48 ' 4 low bits
If WW2>57 Then
WW2=WW2+7 : If LOWERC=1 Then WW2=WW2+32
End If
If WW3>57 Then
WW3=WW3+7 : If LOWERC=1 Then WW3=WW3+32
Endif
outstring=outstring+Chr$(WW2)+Chr$(WW3)
If (separat=1) And ((qq And 1) = 1) And (QQ<15) Then outstring=outstring'+"'"
QQ=QQ+1
If QQ=16 Then Exit Do
Loop
Return OUTSTRING
End Function
'----------------------------------------------------------
function createhash (text as string) as string
'*** MAIN ***
'
' Digests a file and prints the result.
'
Dim As MD5_CTX context
Dim As Uinteger lenn,totallenn,deccounter
Dim As Ubyte digest (0 To 15)
Dim As Ubyte buffer (0 To 16383)
Dim As String COMMA,COMINP,COMOUTP,TEMPS,TEXBUF,SEOL
Dim As Ubyte FFF1,FFF2,FAILURE
'?
'? "MD5 calculator !!!"
'? "Algorithm (C) 1992 RSA, cracked 2005 but who cares :-D"
'?
'
SEOL=Chr$(13)+Chr$(10):FAILURE=0
FFF2=0:COMINP="":COMOUTP=""
'Do
'COMMA=Ucase(Command$(FFF2+1))
COMMA=text
'If COMMA="" Then Exit Do
'If FFF2=0 Then COMINP=COMMA
'If FFF2=1 Then COMOUTP=COMMA
'FFF2=FFF2+1
'Loop
'If FFF2=0 Then
' ? "FAILURE: No arguments found !!!"
' FAILURE=1
'End If
'if FFF2>2 Then
' ? "FAILURE: Too many arguments found !!!"
' FAILURE=1
'End If
'If Failure=0 Then
' FFF1=Freefile
' Open COMINP For Binary Access Read As #FFF1
'
' If ERR<>0 Then
' Print "FAILURE: Failed to open file ";COMINP;" !!!"
' FAILURE=1
' End If
'End If
'If failure=0 Then
' TOTALLENN=Lof(fff1)
' If TOTALLENN=0 Then
' Close FFF1
' Print "FAILURE: Empty file !!!"
' failure=1
' End If
'End If
If failure=0 Then
TIMEA=Timer
deccounter=Len(COMMA)'totallenn
MD5Init (@context)
Do
If DECCOUNTER=0 Then Exit Do
If DECCOUNTER>=16384 Then
DECCOUNTER=DECCOUNTER-16384:LENN=16384
Else
LENN=DECCOUNTER:DECCOUNTER=0
Endif
'Get #FFF1,,buffer(0),lenn
MD5Update (@context, @buffer(0), lenn)
Loop
MD5Final (digest(), @context)
'Close FFF1
timeb=Timer
TEXBUF=COMINP+" "+Str$(TOTALLENN)+" "
TEMPS=MD5Print(@digest(0))
TEXBUF=TEXBUF+TEMPS+SEOL
'? TEXBUF
return TEXBUF
'? "Performance: ";
PERF=TIMEB-TIMEA
'If PERF<1 Then
' ? "??? (File too small, take a bigger one to test)";
'Else
' PERF=(cast(Double,TOTALLENN)/PERF)/1024
' perf=Int(perf)
' ? PERF;" KB/s !!!";
' If PERF<1024 Then ? "BUH it's slooooooooow !!!";
'End If
'?:?
If COMOUTP<>"" Then
'? "Writing result to file:";COMOUTP;" ... ";
FFF1=Freefile
Open COMOUTP For Binary Access Write As #FFF1
If Err=0 Then
Put #FFF1,,TEXBUF
If ERR<>0 Then FAILURE=1
Close FFF1
If ERR<>0 Then FAILURE=1
Else
FAILURE=1
End If
If failure=0 Then
? "OK !"
Else
? "FAILURE:" : ? "Failed to write file ";COMOUTP;" !!!"
End If
?
End If
End If
end function