Maybe someone need
Code: Select all
DeclareModule md5crypt
UseMD5Fingerprint()
Declare.s md5crypt(pass$, salt$)
Declare HexToBuffer(in.s)
EndDeclareModule
Module md5crypt
Procedure.s stringToHex(in.s)
For x = 1 To Len(in)
out.s + Hex(Asc(Mid(in, x, 1)))
Next
ProcedureReturn out.s
EndProcedure
Procedure HexToBuffer(in.s)
*out_buff = AllocateMemory(Len(in) / 2)
For i = 0 To Len(in) - 2 Step 2
PokeA(*out_buff + (i / 2), Val("$" + Mid(in, i + 1, 2)))
Next
ProcedureReturn *out_buff
EndProcedure
Procedure.s To64(Val, Len)
Alphabet.s = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
;PrintN(RSet(Bin(Val),24, "0"))
For j = 1 To Len
Result.s + Mid(Alphabet, Val & $3f + 1, 1)
;Print(RSet(Bin(Val & $3f + 1), 6, "0") + " ")
Val >> 6
Next
;PrintN("")
ProcedureReturn Result
EndProcedure
Procedure.s md5crypt(pass$, salt$)
magic$ = "$1$"
If Len(salt$) > 8
salt$ = Left(salt$, 8)
EndIf
;Start intermediate result
intermediate$ = stringToHex(pass$ + magic$ + salt$)
;compute a separate md5 sum
alternate$ = StringFingerprint(pass$ + salt$ + pass$, #PB_Cipher_MD5)
;Add one byte from alternate For each character in the password. Wtf?
Len = Len(pass$) * 2
While Len >0
If Len >= Len(alternate$)
intermediate$ + alternate$
Len - Len(alternate$)
Else
intermediate$ + Left(alternate$, Len)
Len = 0
EndIf
Wend
;For every 1 bit in the key length, add a 0.
;Otherwise add the first char of the key. WTFFFFF?!
i = Len(pass$)
While i > 0
If i & 1
intermediate$ + "00"
Else
intermediate$ + Hex(PeekA(@pass$))
EndIf
i >> 1
Wend
*inter_buff = HexToBuffer(intermediate$)
intermediate$ = Fingerprint(*inter_buff, MemorySize(*inter_buff), #PB_Cipher_MD5)
FreeMemory(*inter_buff)
;Do additional mutations
For i = 0 To 999
alternate2$ = ""
If i & 1 ; if odd
alternate2$ + stringToHex(pass$)
Else ; if even
alternate2$ + intermediate$
EndIf
If i % 3 ; not divisible by 3
alternate2$ + stringToHex(salt$)
EndIf
If i % 7 ; not divisible by 7
alternate2$ + stringToHex(pass$)
EndIf
If i & 1 ; if odd
alternate2$ + intermediate$
Else ; if even
alternate2$ + stringToHex(pass$)
EndIf
*inter_buff = HexToBuffer(alternate2$)
intermediate$ = Fingerprint(*inter_buff, MemorySize(*inter_buff), #PB_Cipher_MD5)
FreeMemory(*inter_buff)
Next
;Rearrange the bytes And crypt-base64 encode them
*Final_buffer = HexToBuffer(intermediate$)
Final.s + To64((PeekA(*Final_buffer + 0) << 16) | (PeekA(*Final_buffer + 6) << 8) | PeekA(*Final_buffer + 12), 4)
Final.s + To64((PeekA(*Final_buffer + 1) << 16) | (PeekA(*Final_buffer + 7) << 8) | PeekA(*Final_buffer + 13), 4)
Final.s + To64((PeekA(*Final_buffer + 2) << 16) | (PeekA(*Final_buffer + 8) << 8) | PeekA(*Final_buffer + 14), 4)
Final.s + To64((PeekA(*Final_buffer + 3) << 16) | (PeekA(*Final_buffer + 9) << 8) | PeekA(*Final_buffer + 15), 4)
Final.s + To64((PeekA(*Final_buffer + 4) << 16) | (PeekA(*Final_buffer + 10) << 8) | PeekA(*Final_buffer + 5), 4)
Final.s + To64(PeekA(*Final_buffer + 11), 2)
FreeMemory(*Final_buffer)
ProcedureReturn Final
EndProcedure
EndModule
