Good Guys soy un dudoso y me preguntaba si alguien me puede ayudar, así vamos. Al darse cuenta de que yo era todos los fuegos son muy Encryptações Así que he estado viendo alguna función como la que todo el mundo utiliza RC4 Antiguo Ahora estaba pensando en usar un Des, té o hasta que no es un Xor para más encryptar como una clase he intentado de muchas maneras y cryptado me devuelve ... no funciona una muestra de cadena encryptação Contiene una persona Funcionall podría ayudar?
Antiga RC4
[spoiler]Public Function RC4(ByVal Expression As String, ByVal Password As String) As String
On Error Resume Next
Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Key() As Byte, ByteArray() As Byte, Temp As Byte
If Len(Password) = 0 Then
Exit Function
End If
If Len(Expression) = 0 Then
Exit Function
End If
If Len(Password) > 256 Then
Key() = StrConv(Left$(Password, 256), vbFromUnicode)
Else
Key() = StrConv(Password, vbFromUnicode)
End If
For X = 0 To 255
RB(X) = X
Next X
X = 0
Y = 0
Z = 0
For X = 0 To 255
Y = (Y + RB(X) + Key(X Mod Len(Password))) Mod 256
Temp = RB(X)
RB(X) = RB(Y)
RB(Y) = Temp
Next X
X = 0
Y = 0
Z = 0
ByteArray() = StrConv(Expression, vbFromUnicode)
For X = 0 To Len(Expression)
Y = (Y + 1) Mod 256
Z = (Z + RB(Y)) Mod 256
Temp = RB(Y)
RB(Y) = RB(Z)
RB(Z) = Temp
ByteArray(X) = ByteArray(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
Next X
RC4 = StrConv(ByteArray, vbUnicode)
End Function[/spoiler]
On Error Resume Next
Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Key() As Byte, ByteArray() As Byte, Temp As Byte
If Len(Password) = 0 Then
Exit Function
End If
If Len(Expression) = 0 Then
Exit Function
End If
If Len(Password) > 256 Then
Key() = StrConv(Left$(Password, 256), vbFromUnicode)
Else
Key() = StrConv(Password, vbFromUnicode)
End If
For X = 0 To 255
RB(X) = X
Next X
X = 0
Y = 0
Z = 0
For X = 0 To 255
Y = (Y + RB(X) + Key(X Mod Len(Password))) Mod 256
Temp = RB(X)
RB(X) = RB(Y)
RB(Y) = Temp
Next X
X = 0
Y = 0
Z = 0
ByteArray() = StrConv(Expression, vbFromUnicode)
For X = 0 To Len(Expression)
Y = (Y + 1) Mod 256
Z = (Z + RB(Y)) Mod 256
Temp = RB(Y)
RB(Y) = RB(Z)
RB(Z) = Temp
ByteArray(X) = ByteArray(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
Next X
RC4 = StrConv(ByteArray, vbUnicode)
End Function[/spoiler]
Enc String Xor
[spoiler]Public Function XORDecryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To (Len(DataIn) / 2)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
Next lonDataPtr
XORDecryption = strDataOut
End Function
Public Function XOREncryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim temp As Integer
Dim tempstring As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To Len(DataIn)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
temp = (intXOrValue1 Xor intXOrValue2)
tempstring = Hex(temp)
If Len(tempstring) = 1 Then tempstring = "0" & tempstring
strDataOut = strDataOut + tempstring
Next lonDataPtr
XOREncryption = strDataOut
End Function[/spoiler]
Dim lonDataPtr As Long
Dim strDataOut As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To (Len(DataIn) / 2)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
Next lonDataPtr
XORDecryption = strDataOut
End Function
Public Function XOREncryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim temp As Integer
Dim tempstring As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To Len(DataIn)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
temp = (intXOrValue1 Xor intXOrValue2)
tempstring = Hex(temp)
If Len(tempstring) = 1 Then tempstring = "0" & tempstring
strDataOut = strDataOut + tempstring
Next lonDataPtr
XOREncryption = strDataOut
End Function[/spoiler]