PureBasic Forums - English

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