Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
libKryptLog
| Uploader: |  csde_rats |
| Datum/Zeit: | 23.11.2007 21:28:12 |
Declare Function AESenc _
Lib "kryptlog" Alias "AESenc" _
(ByVal pw As String, _
ByRef daten As String) _
As String
Declare Function AESdec _
Lib "kryptlog" Alias "AESdec" _
(ByVal pw As String, _
ByRef daten As String) _
As String
Declare Function md5 _
Lib "kryptlog" Alias "md5" _
(ByVal daten As String) _
As String
'
' 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
'----------------------------------------------------------
#Include "crt.bi"
#Include "crt/stdint.bi"
#Include "crt/string.bi"
#Include "libkryptlog.bi"
Dim Shared As Ubyte SEPARAT=0 '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)
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
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
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)
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)
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)
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)
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
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)
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)
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)
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)
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)
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)
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
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
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
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)
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)
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
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
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
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)
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
' KEncodes inpt (UINT4) into output (unsigned char). Assumes len is
' a multiple of 4.
'
Sub KEncode (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
' KDecodes inpt (unsigned char) into outpt (UINT4). Assumes lenn is
' a multiple of 4.
'
Sub KDecode (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 )
KDecode ( @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
KEncode ( @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
KEncode ( @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 md5_hash(text as string) as String
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
SEOL=Chr$(13)+Chr$(10):FAILURE=0
FFF2=0:COMINP="":COMOUTP=""
If failure=0 Then
TIMEA=Timer
COMMA=Text
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
For n As Integer = LBound(buffer) To UBound(buffer)
buffer(n) = Asc(Mid(text,n,1))
Next
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
End If
end function
Function md5_file (file As String) As String
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
COMOUTP=""
SEOL=Chr$(13)+Chr$(10):FAILURE=0
FFF2=0:COMINP="":COMOUTP=""
COMINP=file
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=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
End If
Return TEXBUF
End Function
Function AESenc (ByVal pw As String, ByRef daten As String) As String
If Len(pw) <> 16 Then Return ""
Return aes_encrypt(daten, pw)
End Function
Function AESdec (ByVal pw As String, ByRef daten As String) As String
If Len(pw) <> 16 Then Return ""
Return aes_decrypt(daten, pw)
End Function
Function md5 (ByVal daten As String) As String
Return md5_hash(daten)
End Function