PureBasic

J'ai passé la journée dessus et il y a un problème.
voici un exemple et cela même sans unicode !
J'ai posé aussi le problème sur le forum anglais mais bon ...
Pffffffffffff quel galère

Code : Tout sélectionner


ProcedureDLL.s RC4(Inp.s, Key.s)
	;encoded.s = RC4("Message", "Password")
	;decoded.s = RC4(encoded, "Password")
	Protected i.l, j.l, t.l, x.l, temp.w, Y.w, Outp.s
	Dim S.w(255)
	Dim K.w(255)
	i.l = 0 : j.l = 0 : t.l = 0 : x.l = 0
	temp.w = 0 : Y.w = 0
	Outp.s = ""
	
    For i = 0 To 255
        S(i) = i
    Next
	
    j = 1
    For i = 0 To 255
        If j>Len(key)
            j = 1
        EndIf
        K(i) = Asc(Mid(key, j, 1))
        j = j + 1
    Next i
	
    j = 0
    For i = 0 To 255
        j = (j + S(i) + K(i)) & 255
        temp = S(i)
        S(i) = S(j)
        S(j) = temp
    Next i
	
    i = 0
    j = 0
    For x = 1 To Len(Inp)
        i = (i + 1) & 255
        j = (j + S(i)) & 255
        temp = S(i)
        S(i) = S(j)
        S(j) = temp
        t = (S(i) + (S(j) & 255)) & 255
        Y = S(t)
        Outp = Outp + Chr(Asc(Mid(Inp, x, 1)) ! Y)
    Next
	ProcedureReturn Outp
EndProcedure

ProcedureDLL.s CryptText(Text.s, Key.s)
	
	ProcedureReturn RC4(Text.s, Key)
EndProcedure

ProcedureDLL.s DeCryptText(Text.s, Key.s)
	ProcedureReturn RC4(Text.s, Key)
EndProcedure

code.s="QZARM69HMA8ZKB"
Debug code
crypt.s = CryptText(code, "16384")
Debug crypt
Debug DeCryptText(crypt, "16384")

Salut,
Dans ta procédure ligne 15, avec j=0 au lieu de j=1 j'obtiens quelquechose qui colle...

Code : Tout sélectionner

  ProcedureDLL.s RC4(Inp.s, key.s)
  ;encoded.s = RC4("Message", "Password")
  ;decoded.s = RC4(encoded, "Password")
  Protected i.l, j.l, t.l, x.l, temp.w, Y.w, Outp.s
  Dim S.w(255)
  Dim K.w(255)
  i.l = 0 : j.l = 0 : t.l = 0 : x.l = 0
  temp.w = 0 : Y.w = 0
  Outp.s = ""
  
  For i = 0 To 255
    S(i) = i
  Next
  
  j = 0 ; ICI j=0 et pas j=1
  For i = 0 To 255
    If j>Len(key)
      j = 1
    EndIf
    K(i) = Asc(Mid(key, j, 1))
    j = j + 1
  Next i
  
  j = 0
  For i = 0 To 255
    j = (j + S(i) + K(i)) & 255
    temp = S(i)
    S(i) = S(j)
    S(j) = temp
  Next i
  
  i = 0
  j = 0
  For x = 1 To Len(Inp)
    i = (i + 1) & 255
    j = (j + S(i)) & 255
    temp = S(i)
    S(i) = S(j)
    S(j) = temp
    t = (S(i) + (S(j) & 255)) & 255
    Y = S(t)
    Outp = Outp + Chr(Asc(Mid(Inp, x, 1)) ! Y)
  Next
  ProcedureReturn Outp
EndProcedure

ProcedureDLL.s CryptText(Text.s, key.s)
  
  ProcedureReturn RC4(Text.s, key)
EndProcedure

ProcedureDLL.s DeCryptText(Text.s, key.s)
  ProcedureReturn RC4(Text.s, key)
EndProcedure

code.s="QZARM69HMA8ZKB"
Debug code
crypt.s = CryptText(code, "16384")
Debug crypt
Debug DeCryptText(crypt, "16384")

résultat :

Code : QZARM69HMA8ZKB
Crypté : ”ÔüäË¶·ME¸Î
Décrypté : QZARM69HMA8ZKB

Et zoup !

Merci Ar-S j'ai testé ton code, ça fonctionnait avec l'exemple, mais dans certain cas ça déconnait encore.... Mais j'ai trouvé la solution là voilà
J'ai passé la journée dessus et c'est finalement grace au forum allemand que j'ai trouvé la solution.
Je vais donc enfin pouvoir sortir tres bientôt une nouvelle version de mon logiciel ThyKeyDB http://www.purebasic.fr/french/viewtopic.php?t=8408
les nouveautés seront :
-Ajout des bouttons Ok/Cancels pour l'ajout et l'édition d'un champ
-Correction d'un petit bug lorsqu'on double clic sur la zone dse Drag'N'Drop des Fichiers et qu'il n'y a pas de fichier.
-utilisation de plugin pour le cryptage (Dans les sources vous verrez c'est tres simple)
-Un plugin RC4 fonctionnel a 100% (non compatible avec les anciennes version)

Je mettrais la nouvelle version sans doute demain ou ce soir si j'ai le temps (j'ai un peu de nettoyage dans les sources) et si j'ai le temps il me reste a developper la possibilité de changer le système de codage sur une base déjà existante.

En tout cas un grand merci a tout ceux qui se sont pencher sur le problème et surtout a Ar-s et kelebrindae qui ont essayé de m'aider !

Code : Tout sélectionner

CompilerIf #PB_Compiler_Unicode = 0
    CompilerError "Vous devez Compiler en mode Unicode"
CompilerEndIf

Procedure.l RC4Mem(Mem.l, memLen.l, key.s) ;rückgabe = adresse des vrschlüsselten speichers
	; RC4 Verschlüsselung >30MB/s
	Protected i.l, t.l, x.l, j.l, temp.l, y.l, l.l, *Sp.Long, *KeyP.Byte, *Memm.Byte
	If key<>""
		Dim S.l(255)
		Dim K.l(255)
		i = 0 : j = 0 : t = 0 : x = 0
		temp = 0 : y = 0
		j = 1
		l.l = Len(key)
		*Sp = @S()
		*KeyP = @key
		For i = 0 To 255
			*Sp\l = i
			*Sp + 4
			If *KeyP\b = 0
				*KeyP = @key
			EndIf
			K(i) = *KeyP\b
			*KeyP + 1
		Next i
		j = 0
		For i = 0 To 255
			j = (j + S(i) + K(i)) & 255
			temp = S(i)
			S(i) = S(j)
			S(j) = temp
		Next i
		i = 0
		j = 0
		*Memm = Mem
		For x = 0 To memLen-1
			i = (i + 1) & 255
			j = (j + S(i)) & 255
			;temp = S(i)
			;S(i) = S(j)
			;S(j) = temp
			Swap S(i), S(j)
			t = (S(i) + (S(j) & 255)) & 255
			y = S(t)
			*Memm\b ! y
			*Memm + 1
		Next
		ProcedureReturn Mem
	EndIf
	ProcedureReturn 0
EndProcedure

ProcedureDLL.s CryptText(string.s, Key.s)
	Protected strlen.l, enc.s, *codetmem
	strlen = StringByteLength(string)
	enc.s = Space(Int(strlen*1.35))
	*codetmem = RC4Mem(@string, strlen, key)
	Base64Encoder(*codetmem, strlen, @enc, strlen*1.35)
	ProcedureReturn enc
EndProcedure

ProcedureDLL.s DeCryptText(string.s, Key.s)
	Protected strlen.l, dec.s, decoutp.s, str2len.l, *decodetmem
	strlen = StringByteLength(string)
	dec.s = Space(Int(strlen*0.75))
	str2len.l = Base64Decoder(@string, strlen, @dec, strlen*0.75)
	*decodetmem = RC4Mem(@dec, str2len, key)
	decoutp.s = PeekS(*decodetmem, str2len)
	ProcedureReturn decoutp.s
EndProcedure

;code.s = "Youpie ça marche "
;Debug code 
;crypt.s = CryptText(code, "test")
;Debug crypt
;Debug DeCryptText(crypt, "test")

PureBasic

Besoin d'aide bug cryptage [Résolu]