Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
AES,md5
| Uploader: |  csde_rats |
| Datum/Zeit: | 04.09.2007 17:14:07 |
'
' 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.
'----------------------------------------------------------
' AES Encryption Implementation by: Chris Brown(2007) aka Zamaster
'
' -Takes plain text and converts it to encrypted ASCII
' -Keys must be 128 bits in size, or 32 hex places/16 char places
' -Set ed in RIJNDAEL_Encrypt to 2 for decryption, 1 for encryption
declare function aes_encrypt lib "krlib" alias "AES_encrypt" (Text as string, Key as string) as string
declare function aes_decrypt lib "krlib" alias "AES_decrypt" (Text as string, Key as string) as string
Declare function md5_hash Lib "krlib" Alias "MD5_hash" (text as string) as string
#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)
'-----------------------------------------------------------
Sub RIJNDAEL_ConvertEXPtoKey(index As Integer, ekey() As Ubyte, tkey() As Ubyte) Export
Dim As Ubyte x,y,b
b = (index-1)*4
For y = 1 To 4
For x = 1 To 4
tkey(x,y) = ekey(b+x,y)
Next x
Next y
End Sub
Function RIJNDAEL_InverseS(v As Ubyte) As Ubyte Export
Static As Ubyte RSBOX(0 To 255) = {_
&H52, &H09, &H6A, &HD5, &H30, &H36, &HA5, &H38, &HBF, &H40, &HA3, &H9E, &H81, &HF3, &HD7, &HFB, _
&H7C, &HE3, &H39, &H82, &H9B, &H2F, &HFF, &H87, &H34, &H8E, &H43, &H44, &HC4, &HDE, &HE9, &HCB, _
&H54, &H7B, &H94, &H32, &HA6, &HC2, &H23, &H3D, &HEE, &H4C, &H95, &H0B, &H42, &HFA, &HC3, &H4E, _
&H08, &H2E, &HA1, &H66, &H28, &HD9, &H24, &HB2, &H76, &H5B, &HA2, &H49, &H6D, &H8B, &HD1, &H25, _
&H72, &HF8, &HF6, &H64, &H86, &H68, &H98, &H16, &HD4, &HA4, &H5C, &HCC, &H5D, &H65, &HB6, &H92, _
&H6C, &H70, &H48, &H50, &HFD, &HED, &HB9, &HDA, &H5E, &H15, &H46, &H57, &HA7, &H8D, &H9D, &H84, _
&H90, &HD8, &HAB, &H00, &H8C, &HBC, &HD3, &H0A, &HF7, &HE4, &H58, &H05, &HB8, &HB3, &H45, &H06, _
&HD0, &H2C, &H1E, &H8F, &HCA, &H3F, &H0F, &H02, &HC1, &HAF, &HBD, &H03, &H01, &H13, &H8A, &H6B, _
&H3A, &H91, &H11, &H41, &H4F, &H67, &HDC, &HEA, &H97, &HF2, &HCF, &HCE, &HF0, &HB4, &HE6, &H73, _
&H96, &HAC, &H74, &H22, &HE7, &HAD, &H35, &H85, &HE2, &HF9, &H37, &HE8, &H1C, &H75, &HDF, &H6E, _
&H47, &HF1, &H1A, &H71, &H1D, &H29, &HC5, &H89, &H6F, &HB7, &H62, &H0E, &HAA, &H18, &HBE, &H1B, _
&HFC, &H56, &H3E, &H4B, &HC6, &HD2, &H79, &H20, &H9A, &HDB, &HC0, &HFE, &H78, &HCD, &H5A, &HF4, _
&H1F, &HDD, &HA8, &H33, &H88, &H07, &HC7, &H31, &HB1, &H12, &H10, &H59, &H27, &H80, &HEC, &H5F, _
&H60, &H51, &H7F, &HA9, &H19, &HB5, &H4A, &H0D, &H2D, &HE5, &H7A, &H9F, &H93, &HC9, &H9C, &HEF, _
&HA0, &HE0, &H3B, &H4D, &HAE, &H2A, &HF5, &HB0, &HC8, &HEB, &HBB, &H3C, &H83, &H53, &H99, &H61, _
&H17, &H2B, &H04, &H7E, &HBA, &H77, &HD6, &H26, &HE1, &H69, &H14, &H63, &H55, &H21, &H0C, &H7D}
Dim As Integer x
x = RSBOX((v And &HF0) + (v And &HF))
Return x
End Function
Function RIJNDAEL_S(v As Ubyte) As Ubyte Export
Static As Ubyte RSBOX(0 To 255) = {_
&H63, &H7C, &H77, &H7B, &HF2, &H6B, &H6F, &HC5, &H30, &H01, &H67, &H2B, &HFE, &HD7, &HAB, &H76, _
&HCA, &H82, &HC9, &H7D, &HFA, &H59, &H47, &HF0, &HAD, &HD4, &HA2, &HAF, &H9C, &HA4, &H72, &HC0, _
&HB7, &HFD, &H93, &H26, &H36, &H3F, &HF7, &HCC, &H34, &HA5, &HE5, &HF1, &H71, &HD8, &H31, &H15, _
&H04, &HC7, &H23, &HC3, &H18, &H96, &H05, &H9A, &H07, &H12, &H80, &HE2, &HEB, &H27, &HB2, &H75, _
&H09, &H83, &H2C, &H1A, &H1B, &H6E, &H5A, &HA0, &H52, &H3B, &HD6, &HB3, &H29, &HE3, &H2F, &H84, _
&H53, &HD1, &H00, &HED, &H20, &HFC, &HB1, &H5B, &H6A, &HCB, &HBE, &H39, &H4A, &H4C, &H58, &HCF, _
&HD0, &HEF, &HAA, &HFB, &H43, &H4D, &H33, &H85, &H45, &HF9, &H02, &H7F, &H50, &H3C, &H9F, &HA8, _
&H51, &HA3, &H40, &H8F, &H92, &H9D, &H38, &HF5, &HBC, &HB6, &HDA, &H21, &H10, &HFF, &HF3, &HD2, _
&HCD, &H0C, &H13, &HEC, &H5F, &H97, &H44, &H17, &HC4, &HA7, &H7E, &H3D, &H64, &H5D, &H19, &H73, _
&H60, &H81, &H4F, &HDC, &H22, &H2A, &H90, &H88, &H46, &HEE, &HB8, &H14, &HDE, &H5E, &H0B, &HDB, _
&HE0, &H32, &H3A, &H0A, &H49, &H06, &H24, &H5C, &HC2, &HD3, &HAC, &H62, &H91, &H95, &HE4, &H79, _
&HE7, &HC8, &H37, &H6D, &H8D, &HD5, &H4E, &HA9, &H6C, &H56, &HF4, &HEA, &H65, &H7A, &HAE, &H08, _
&HBA, &H78, &H25, &H2E, &H1C, &HA6, &HB4, &HC6, &HE8, &HDD, &H74, &H1F, &H4B, &HBD, &H8B, &H8A, _
&H70, &H3E, &HB5, &H66, &H48, &H03, &HF6, &H0E, &H61, &H35, &H57, &HB9, &H86, &HC1, &H1D, &H9E, _
&HE1, &HF8, &H98, &H11, &H69, &HD9, &H8E, &H94, &H9B, &H1E, &H87, &HE9, &HCE, &H55, &H28, &HDF, _
&H8C, &HA1, &H89, &H0D, &HBF, &HE6, &H42, &H68, &H41, &H99, &H2D, &H0F, &HB0, &H54, &HBB, &H16}
Dim As Integer x
x = RSBOX((v And &HF0) + (v And &HF))
Return x
End Function
Sub RIJNDAEL_SubBytes(T() As Ubyte) Export
Dim As Ubyte x,y, temp
For y = 1 To 4
For x = 1 To 4
temp = T(x,y)
T(x,y) = RIJNDAEL_S(temp)
Next x
Next y
End Sub
Sub RIJNDAEL_InverseSubBytes(T() As Ubyte) Export
Dim As Ubyte x,y, temp
For y = 1 To 4
For x = 1 To 4
temp = T(x,y)
T(x,y) = RIJNDAEL_InverseS(temp)
Next x
Next y
End Sub
Sub RIJNDAEL_ShiftRows(T() As Ubyte) Export
Swap T(1,2), T(4,2)
Swap T(2,2), T(1,2)
Swap T(3,2), T(2,2)
Swap T(1,3), T(3,3)
Swap T(2,3), T(4,3)
Swap T(1,4), T(2,4)
Swap T(3,4), T(4,4)
Swap T(1,4), T(3,4)
End Sub
Sub RIJNDAEL_InverseShiftRows(T() As Ubyte) Export
Swap T(1,2), T(2,2)
Swap T(1,2), T(4,2)
Swap T(3,2), T(4,2)
Swap T(1,3), T(3,3)
Swap T(2,3), T(4,3)
Swap T(1,4), T(2,4)
Swap T(2,4), T(3,4)
Swap T(3,4), T(4,4)
End Sub
Function RIJNDAEL_Gmul(Byval a As Ubyte, Byval b As Ubyte) As Ubyte Export
Dim As Ubyte p, myi, hi
for myi = 1 To 8
If (b And 1) = &H01 Then p = p Xor a
hi = a And &H80
a = a Shl 1
If hi = &H80 Then a = a Xor &H1B
b = b Shr 1
Next i
Return p
End Function
Sub RIJNDAEL_MixCollums(T() As Ubyte) Export
Dim As Ubyte a(1 To 4), b(1 To 4), myi, q, hb
For q = 1 To 4
for myi = 1 To 4
a(myi) = T(q,myi)
hb = T(q,myi) And &H80
b(myi) = a(myi) Shl 1
If hb = &h80 Then b(myi) = b(myi) Xor &H1B
Next i
T(q,1) = b(1) Xor a(4) Xor a(3) Xor b(2) Xor a(2)
T(q,2) = b(2) Xor a(1) Xor a(4) Xor b(3) Xor a(3)
T(q,3) = b(3) Xor a(2) Xor a(1) Xor b(4) Xor a(4)
T(q,4) = b(4) Xor a(3) Xor a(2) Xor b(1) Xor a(1)
Next q
End Sub
Sub RIJNDAEL_InverseMixCollums(T() As Ubyte) Export
Dim As Ubyte a(1 To 4), q, myi
For q = 1 To 4
for myi = 1 To 4
a(myi) = T(q,myi)
Next
T(q,1) = RIJNDAEL_Gmul(a(1),&HE) Xor RIJNDAEL_Gmul(a(2),&HB) Xor RIJNDAEL_Gmul(a(3),&HD) Xor RIJNDAEL_Gmul(a(4),&H9)
T(q,2) = RIJNDAEL_Gmul(a(1),&H9) Xor RIJNDAEL_Gmul(a(2),&HE) Xor RIJNDAEL_Gmul(a(3),&HB) Xor RIJNDAEL_Gmul(a(4),&HD)
T(q,3) = RIJNDAEL_Gmul(a(1),&HD) Xor RIJNDAEL_Gmul(a(2),&H9) Xor RIJNDAEL_Gmul(a(3),&HE) Xor RIJNDAEL_Gmul(a(4),&HB)
T(q,4) = RIJNDAEL_Gmul(a(1),&HB) Xor RIJNDAEL_Gmul(a(2),&HD) Xor RIJNDAEL_Gmul(a(3),&H9) Xor RIJNDAEL_Gmul(a(4),&HE)
Next q
End Sub
Sub RIJNDAEL_AddKey(T() As Ubyte, K() As Ubyte) Export
Dim As Ubyte x,y
For y = 1 To 4
For x = 1 To 4
T(x,y) = T(x,y) Xor K(x,y)
Next x
Next y
End Sub
Sub RIJNDAEL_ExpandKey(K1() As Ubyte, K2() As Ubyte) Export
Static As Ubyte RCON(1 To 10) = {&H01, &H02, &H04, &H08, &H10, &H20, &H40, &H80, &H1B, &H36}
Dim As Integer myi, q, a, opt4, opt4m1, opt4m4, o4, om1, om4
K2(1,1) = K1(1,1) Xor RIJNDAEL_S(K1(4,2)) Xor RCON(1)
K2(1,2) = K1(1,2) Xor RIJNDAEL_S(K1(4,3))
K2(1,3) = K1(1,3) Xor RIJNDAEL_S(K1(4,4))
K2(1,4) = K1(1,4) Xor RIJNDAEL_S(K1(4,1))
for myi = 2 To 4
For q = 1 To 4
K2(myi,q) = K2(myi-1,q) Xor K1(myi,q)
Next q
Next i
for myi = 2 To 10
opt4 = ((myi-1) Shl 2) + 1
opt4m1 = opt4 - 1
opt4m4 = opt4 - 4
K2(opt4,1) = K2(opt4m4,1) Xor RIJNDAEL_S(K2(opt4m1,2)) Xor RCON(myi)
K2(opt4,2) = K2(opt4m4,2) Xor RIJNDAEL_S(K2(opt4m1,3))
K2(opt4,3) = K2(opt4m4,3) Xor RIJNDAEL_S(K2(opt4m1,4))
K2(opt4,4) = K2(opt4m4,4) Xor RIJNDAEL_S(K2(opt4m1,1))
For q = 2 To 4
o4 = opt4m1 + q
om1 = o4-1
om4 = o4-4
For a = 1 To 4
K2(o4,a) = K2(om1,a) Xor K2(om4,a)
Next a
Next q
Next i
End Sub
Sub RIJNDAEL_TextToState(Byref texts As String, T() As Ubyte, dirc As Integer) Export
Dim As String text
text = texts
Dim As Ubyte x,y
If dirc = 1 Then
For y = 1 To 4
For x = 1 To 4
T(x,y) = Asc(Mid$(text,(((y-1) Shl 2) + x),1))
Next x
Next y
Else
For y = 1 To 4
For x = 1 To 4
T(y,x) = Asc(Mid$(text,(((y-1) Shl 2) + x),1))
Next x
Next y
Endif
End Sub
Sub RIJNDAEL_Rotate(K() As Ubyte) Export
Swap K(1,2), K(2,1)
Swap K(1,3), K(3,1)
Swap K(1,4), K(4,1)
Swap K(2,4), K(4,2)
Swap K(3,4), K(4,3)
Swap K(2,3), K(3,2)
End Sub
Function RIJNDAEL_StateToText(T() As Ubyte) As String Export
Dim As String s
Dim As Integer x,y
For y = 1 To 4
For x = 1 To 4
s += Chr$(T(x,y))
Next x
Next y
Return s
End Function
Function RIJNDAEL_StrToHex (Byref s As String) As String Export
Dim As String convstr
convstr = s
Dim As Uinteger myi
Dim As String ftext
for myi = 1 To Len(convstr)
ftext += Hex$(Asc(Mid$(convstr,myi,1)),2)
Next i
Return ftext
End Function
Function RIJNDAEL_HexToStr (Byref s As String) As String Export
Dim As String convstr
convstr = s
If Len(convstr) Mod 2 = 1 Then convstr += "0"
Dim As Uinteger myi
Dim As String myf
for myi = 1 To Len(convstr) Step 2
myf += Chr$(Val("&H"+Mid$(convstr,myi,2)))
Next myi
Return myf
End Function
Sub RIJNDAEL_BlockEncrypt(T() As Ubyte, K1() As Ubyte, K2() As Ubyte) Export
Dim As Integer myi
Dim As Ubyte TempKey(1 To 4, 1 To 4)
RIJNDAEL_AddKey T(), K1()
RIJNDAEL_Rotate T()
for myi = 1 To 9
RIJNDAEL_SubBytes T()
RIJNDAEL_ShiftRows T()
RIJNDAEL_MixCollums T()
RIJNDAEL_ConvertEXPtoKey myi, K2(), TempKey()
RIJNDAEL_AddKey T(), TempKey()
Next i
RIJNDAEL_SubBytes T()
RIJNDAEL_ShiftRows T()
RIJNDAEL_ConvertEXPtoKey 10, K2(), TempKey()
RIJNDAEL_AddKey T(), TempKey()
End Sub
Sub RIJNDAEL_BlockDecrypt(T() As Ubyte, K1() As Ubyte, K2() As Ubyte) Export
Dim As Integer myi
Dim As Ubyte TempKey(1 To 4, 1 To 4)
RIJNDAEL_ConvertEXPtoKey 10, K2(), TempKey()
RIJNDAEL_AddKey T(), TempKey()
for myi = 9 To 1 Step -1
RIJNDAEL_InverseShiftRows T()
RIJNDAEL_InverseSubBytes T()
RIJNDAEL_ConvertEXPtoKey myi, K2(), TempKey()
RIJNDAEL_AddKey T(), TempKey()
RIJNDAEL_InverseMixCollums T()
Next i
RIJNDAEL_InverseShiftRows T()
RIJNDAEL_InverseSubBytes T()
RIJNDAEL_AddKey T(), K1()
End Sub
Function RIJNDAEL_Encrypt(Byref pptext As String, Byref Key As String, ed As Integer) As String Export
If ed < 1 Or ed > 2 Then
Beep
Return "ERROR - NO SUCH ENCRYPTION MODE"
Endif
Dim As String ptext, ctext, mtext
ptext = pptext
Dim As Integer lt
lt = Len(Key)
If (lt Mod 16 <> 0) Or (lt Shr 4 <> 1) Then
Return "ERROR - INVALID KEY"
Endif
Dim As Integer pmod, myi
lt = Len(ptext)
pmod = lt Mod 16
If pmod <> 0 Or lt < 1 Then
pmod = 16 - pmod
for myi = 1 To pmod
ptext += Chr$(0)
Next i
Endif
lt = Len(ptext)
lt = lt Shr 4
Dim As Ubyte State(1 To 4, 1 To 4), KeyT(1 To 4, 1 To 4), EXPKey(1 To 40, 1 To 4)
RIJNDAEL_TextToState Key, KeyT(), 2
RIJNDAEL_ExpandKey KeyT(), EXPKey()
Select Case ed
Case 1
for myi = 1 To lt
mtext = Mid$(ptext, ((myi-1) Shl 4) + 1, 16)
RIJNDAEL_TextToState mtext, State(), 1
RIJNDAEL_BlockEncrypt State(), KeyT(), EXPKey()
ctext += RIJNDAEL_StateToText(State())
Next i
Case 2
RIJNDAEL_Rotate KeyT()
for myi = 1 To lt
mtext = Mid$(ptext, ((myi-1) Shl 4) + 1, 16)
RIJNDAEL_TextToState mtext, State(), 1
RIJNDAEL_BlockDecrypt State(), KeyT(), EXPKey()
RIJNDAEL_Rotate State()
ctext += RIJNDAEL_StateToText(State())
Next i
End Select
Return ctext
End Function
function aes_encrypt(Text as string, Key as string) as string export
if len(Key) <> 16 then
exit function
end if
dim encrypted as string
encrypted = RIJNDAEL_Encrypt(Text, Key, 1)
return encrypted
end function
function aes_decrypt(Text as string, Key as string) as string export
dim decrypted as string
decrypted = RIJNDAEL_Encrypt(Text, Key, 2)
return decrypted
end function
' MD5 initialization. Begins an MD5 operation, writing a new context.
'
Sub MD5Init (context As MD5_CTX Ptr) Export
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 Export
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 Export
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 Export
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) Export
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) Export
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 Export
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 export
'*** 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