Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

JGD

[Resolvido] Criptografia/descripatografia com chave

Recommended Posts

Olá Pessoal,

Preciso implementar uma forma de transitar dados/string, seja “port” ou “get” ou ainda via link , de forma segura e gostaria obter formas e/ou sugestões de criptografar e descriptografar uma string com chave.

 

 

Achei na Net a função abaixo que esta em PHP e estou utilizando-a como base.

 

Tentei em baralhar e converter para base64 (em ASP mesmo) tentando colocar uma chave junto; mais não tive sucesso.

1º que não estou sabendo tratar os itens da string (em relação ao exemplo php abaixo) e 2º que dependendo da combinação há a ocorrência do sinal de igual (=) ou duplo igual (==) no final da string criptografada inviabilizando na utilização em link....

 

 

////////////////////////////////////////////////////////////////////////////////////////////////////

<?

/*

encrypt criptografa e/ou descriptografa uma string qualquer, fornecida no parametro "frase" com uma chave qualquer executando um

XOR entre cada caractere, invertendo a sequencia e codificando em hexadecimal.

Se $crypt = true, a função criptografa a frase fornecida. Caso false ela a descriptografa.

Crédito: Ebenézer http://ebenezerbotelho.blogspot.com.br/2010/05/criptografia-e-descriptografia-com-php.html.

Exemplo de uso:

*/

 

function encrypt($frase, $chave, $crypt){

$retorno = "";

 

if ($frase=='') return '';

 

if($crypt){

//echo "0 ".$crypt."<br>";

$string = $frase;

$i = strlen($string)-1;

//echo "1 ".$i."<br>";

 

$j = strlen($chave);

//echo "2 ".$j."<br>";

 

do{

 

//echo "3 ".$i."<br>";

//echo "4 ".$string{$i}."<br>";

//echo "5 ".$chave{$i % $j}."<br>";

 

 

$retorno .= ($string{$i} ^ $chave{$i % $j});

 

//echo "6 ".$retorno."<br>";

 

}while ($i--);

 

$retorno = strrev($retorno);

 

//echo "7 ".$retorno."<br>";

 

 

$retorno = base64_encode($retorno);

 

//echo "8 ".$retorno."<br>";

 

 

} else {

$string = base64_decode($frase);

$i = strlen($string)-1;

$j = strlen($chave);

 

do

{

$retorno .= ($string{$i} ^ $chave{$i % $j});

}while ($i--);

 

$retorno = strrev($retorno);

}

return $retorno;

}

 

$chave = "q6w43a2sc1d6e98r6d5f6dasdfa313d525a35dsf";//Chave a ser utilizada na criptografia/descriptografia

$frase = "01|paramentro1|teste@aaa.com.br|paramentro3|Teste de encriptação de frases|";

$crypt = encrypt($frase, $chave, true);

$decrypt = encrypt($crypt, $chave, false);

echo "Frase = ".$frase."<br>";

echo "Cript = ".$crypt."<br>";

echo "Decript = ".$decrypt."<br>";

?>

//////////////////////////////////////////////////////

 

 

Agradeço qualquer indicação de implementação.

 

JGD

Compartilhar este post


Link para o post
Compartilhar em outros sites

dá uma olhada no lab. de script, que coloquei alguns artigos sobre o assunto, só que fique atento pois dependendo da criptografia, tipo MD5 é unilateral,

 

abaixo um exemplo mais simples, porem funcional

 

<%
Const EncC1 = 109
Const EncC2 = 191
Const EncKey = 161

Public Function EncriptaStr(Texto)
       Dim TempStr, TempResult, TempNum, TempChar
       Dim TempKey
       Dim i
       TempStr = Texto
       TempResult = ""
       TempKey = ((EncKey * EncC1) + EncC2) Mod 65536
       For i = 1 To Len(TempStr)
               TempNum = (Asc(Mid(TempStr, i, 1)) Xor (AuxShr(TempKey, 8))) Mod 256
               TempChar = Chr(TempNum)
               TempKey = (((Asc(TempChar) + TempKey) * EncC1) + EncC2) Mod 65536
               TempResult = TempResult & TempChar
       Next
       EncriptaStr = TempResult
End Function


Public Function DecriptaStr(Texto)
       Dim TempStr, TempResult, TempNum, TempChar
       Dim TempKey
       Dim i
       TempStr = Texto
       TempResult = ""
       TempKey = ((EncKey * EncC1) + EncC2) Mod 65536
       For i = 1 To Len(TempStr)
               TempNum = (Asc(Mid(TempStr, i, 1)) Xor (AuxShr(TempKey, 8))) Mod 256
               TempChar = Chr(TempNum)
               TempKey = (((Asc(Mid(TempStr, i, 1)) + TempKey) * EncC1) + EncC2) Mod 65536
               TempResult = TempResult & TempChar
       Next
       DecriptaStr = TempResult
End Function

Private Function AuxShr(Numero, BShr)
AuxShr = Int(Numero / (2 ^ BShr))
End Function

VarStr = "Teste de Cripto"

VarTeste = EncriptaStr(VarStr)
Response.Write _
VarTeste & "<br>" & _
DecriptaStr(VarTeste)

%>

 

como também tenho esse classe

 

<%
'=======================================================
'CLASSE DE CRIPTOGRAFIA DE STRINGS
'=======================================================
Class Criptografia

'-----------------------------------------------------
'Atributos/Constantes da Classe
'-----------------------------------------------------
Private dblCenterY
Private dblCenterX
Private LastResult
Private LastErrDes
Private LastErrNum 
Private errInvalidKeyLength
Private errInvalidKey
Private errInvalidSize
Private errKeyMissing
Private errClearTextMissing
Private errCipherTextMissing
Private A
Private B
Private C
Private D
Private E
Private F

'-----------------------------------------------------
'Procedimentos de Inicialização de Destruição da Classe
'-----------------------------------------------------
Private Sub Class_Initialize()
	'Inivializando as variáveis
	errInvalidKeyLength = 65101
	errInvalidKey = 65102
	errInvalidSize = 65103
	errKeyMissing = 65303
	errClearTextMissing = 65304
	errCipherTextMissing = 65305
	A = 10
	B = 11
	C = 12
	D = 13
	E = 14
	F = 15
End Sub
Private Sub Class_Terminate()
End Sub

Function QuickEncrypt(strClear, strKey)
	Dim intRet
	intRet = EncryptText(strClear, strKey)
	If intRet = -1 Then
		QuickEncrypt = "ERROR"
	Else
		QuickEncrypt = LastResult
	End If
End Function

Function QuickDecrypt(strCipher, strKey)
	Dim intRet
	intRet = DecryptText(strCipher, strKey)
	If intRet = -1 Then
		QuickDecrypt = "ERROR"
	Else
		QuickDecrypt = LastResult
	End If
End Function

Function GetStrength(strPassword)
	strPassword = CStr(strPassword)
	GetStrength = (Len(strPassword) * 8) + (Len(GetSerial) * 8)
End Function

Function GetSerial()
	GetSerial = Now
End Function

Function GetHash(strKey)
    Dim strCipher
    Dim byKey()
    ReDim byKey(Len(strKey))
    For i = 1 To Len(strKey)
        byKey(i) = Asc(Mid(strKey, i, 1))
    Next

    For i = 1 To UBound(byKey) / 2
        strCipher = strCipher & NumToHex(byKey(i) Xor byKey((UBound(byKey) - i) + 1))
    Next
    GetHash = strCipher
End Function

Function CreatePassword(strSeed, lngLength)
    Dim bySeed()
    Dim bySerial()
    Dim strTimeSerial
    Dim Random
    Dim lngPosition
    Dim lngSerialPosition
    strCipher = ""
    lngPosition = 1
    lngSerialPosition = 1
    ReDim bySeed(Len(strSeed))
    For i = 1 To Len(strSeed)
      bySeed(i) = Asc(Mid(strSeed, i, 1))
    Next
    strTimeSerial = GetSerial()
    ReDim bySerial(Len(strTimeSerial))
    For i = 1 To Len(strTimeSerial)
      bySerial(i) = Asc(Mid(strTimeSerial, i, 1))
    Next
    ReCenter CDbl(bySeed(lngPosition)), CDbl(bySerial(lngSerialPosition))
    lngPosition = lngPosition + 1
    lngSerialPosition = lngSerialPosition + 1
    For i = 1 To (lngLength / 2)
		Generate CDbl(bySeed(lngPosition)), CDbl(bySerial(lngSerialPosition)), False
		strCipher = strCipher & NumToHex(MakeRandom(dblCenterX, 255))
		strCipher = strCipher & NumToHex(MakeRandom(dblCenterY, 255))
		If lngPosition = Len(strSeed) Then
			lngPosition = 1
        Else
			lngPosition = lngPosition + 1
        End If
        If lngSerialPosition = Len(strTimeSerial) Then
			lngSerialPosition = 1
        Else
			lngSerialPosition = lngSerialPosition + 1
        End If
    Next
    CreatePassword = Left(strCipher, lngLength)
End Function

Sub ReCenter(mdblCenterY, mdblCenterX)
    dblCenterY = mdblCenterY
    dblCenterX = mdblCenterX
End Sub

Sub Generate(dblRadius, dblTheta, blnRad)
    Const Pi = 3.14159265358979
    Const sngMaxUpper = 2147483647
    Const sngMaxLower = -2147483648
    If blnRad = False Then
        If (dblRadius * Cos((dblTheta / 180) * Pi)) + dblCenterX > sngMaxUpper Or (dblRadius * Cos((dblTheta / 180) * Pi)) + dblCenterX < sngMaxLower Then
            ReCenter dblCenterY, 0
        Else
            dblCenterX = (dblRadius * Cos((dblTheta / 180) * Pi)) + dblCenterX
        End If

        If (dblRadius * Sin((dblTheta / 180) * Pi)) + dblCenterY > sngMaxUpper Or (dblRadius * Sin((dblTheta / 180) * Pi)) + dblCenterY < sngMaxLower Then
            ReCenter 0, dblCenterX
        Else
            dblCenterY = (dblRadius * Sin((dblTheta / 180) * Pi)) + dblCenterY
        End If
    Else
        If (dblRadius * Cos(dblTheta)) + dblCenterX > sngMaxUpper Or (dblRadius * Cos(dblTheta)) + dblCenterX < sngMaxLower Then
            ReCenter dblCenterY, 0
        Else
            dblCenterX = (dblRadius * Cos(dblTheta)) + dblCenterX
        End If

        If (dblRadius * Sin(dblTheta)) + dblCenterY > sngMaxUpper Or (dblRadius * Sin(dblTheta)) + dblCenterY < sngMaxLower Then
            ReCenter 0, dblCenterX
        Else
            dblCenterY = (dblRadius * Sin(dblTheta)) + dblCenterY
        End If
    End If
End Sub

Function MakeRandom(dblValue, lngMax)
    Dim lngRandom
    lngRandom = Int(dblValue Mod (lngMax + 1))
    If lngRandom > lngMax Then
        lngRandom = 0
    End If
    MakeRandom = Abs(lngRandom)
End Function

Sub RaiseError(lngErrNum, strErrDes)
    LastErrDes = strErrDes
    LastErrNum = lngErrNum
End Sub

Function EncryptText(strClear, strKey)
    Dim byClear()
    Dim byKey()
    Dim byCipher()
    Dim lngPosition
    Dim lngSerialPosition
    Dim strTimeSerial
    Dim blnSecondValue
    Dim strCipher
    Dim i
    strKey = CStr(strKey)
    strClear = CStr(strClear)
    If strKey = "" Then
        RaiseError errKeyMissing, "Key Missing"
		EncryptText = -1
		Exit Function
    End If
    If Len(strKey) <= 1 Then
        RaiseError errInvalidKeyLength, "Invalid Key Length"
		EncryptText = -1
		Exit Function
    End If
    strTimeSerial = GetSerial()
    ReDim byKey(Len(strKey))
    For i = 1 To Len(strKey)
        byKey(i) = Asc(Mid(strKey, i, 1))
    Next
    If Len(strClear) = 0 Then
        RaiseError errInvalidSize, "Text Has Zero Length"
		EncryptText = -1
		Exit Function
    End If
    ReDim byClear(Len(strClear))
    For i = 1 To Len(strClear)
        byClear(i) = Asc(Mid(strClear, i, 1))
    Next
    lngPosition = 1
    lngSerialPosition = 1
    For i = 1 To UBound(byKey) / 2
        strCipher = strCipher & NumToHex(byKey(i) Xor byKey((UBound(byKey) - i) + 1))
    Next
    lngPosition = 1
    strCipher = strCipher & NumToHex(Len(strTimeSerial) Xor byKey(lngPosition))
    lngPosition = lngPosition + 1
    For i = 1 To Len(strTimeSerial)
        strCipher = strCipher & NumToHex(byKey(lngPosition) Xor Asc(Mid(strTimeSerial, i, 1)))
           If lngPosition = UBound(byKey) Then
               lngPosition = 1
           Else
               lngPosition = lngPosition + 1
           End If
    Next
    lngPosition = 1
    lngSerialPosition = 1
    ReCenter CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1))
    lngPosition = lngPosition + 1
    lngSerialPosition = lngSerialPosition + 1
    blnSecondValue = False     
    For i = 1 To UBound(byClear)    
		If blnSecondValue = False Then
			Generate CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1)), False
			strCipher = strCipher & NumToHex(byClear(i) Xor MakeRandom(dblCenterX, 255))
            blnSecondValue = True
           Else
			strCipher = strCipher & NumToHex(byClear(i) Xor MakeRandom(dblCenterY, 255))
               blnSecondValue = False
           End If
           If lngPosition = UBound(byKey) Then
			lngPosition = 1
		Else
			lngPosition = lngPosition + 1
		End If
		If lngSerialPosition = Len(strTimeSerial) Then
			lngSerialPosition = 1
		Else
			lngSerialPosition = lngSerialPosition + 1
		End If
    Next
    LastResult = strCipher
    EncryptText = 1
    Exit Function
End Function

Public Function DecryptText(strCipher, strKey)
    Dim strClear
    Dim byCipher()
    Dim byKey()
    Dim strTimeSerial
    Dim strCheckKey
    Dim lngPosition
    Dim lngSerialPosition
    Dim lngCipherPosition
    Dim bySerialLength
    Dim blnSecondValue
    Dim i
    strCipher = CStr(strCipher)
    strKey = CStr(strKey)
    If Len(strCipher) = 0 Then
		RaiseError errCipherTextMissing, "Cipher Text Missing"
		DecryptText = -1
		Exit Function
    End If
    If Len(strCipher) < 10 Then
		RaiseError errInvalidSize, "Bad Text Length"
		DecryptText = -1
		Exit Function
    End If
    If Len(strKey) = 0 Then
		RaiseError errKeyMissing, "Key Missing"
		DecryptText = -1
		Exit Function
    End If
    If Len(strKey) <= 1 Then
		RaiseError errInvalidKeyLength, "Invalid Key Length"
		DecryptText = -1
		Exit Function
    End If
    ReDim byKey(Len(strKey))
    For i = 1 To Len(strKey)
        byKey(i) = Asc(Mid(strKey, i, 1))
    Next
    ReDim byCipher(Len(strCipher) / 2)
    lngCipherPosition = 1
    For i = 1 To Len(strCipher) Step 2
        byCipher(lngCipherPosition) = HexToNum(Mid(strCipher, i, 2))
        lngCipherPosition = lngCipherPosition + 1
    Next
    lngCipherPosition = 1
    For i = 1 To UBound(byKey) / 2
        strCheckKey = strCheckKey & NumToHex(byKey(i) Xor byKey((UBound(byKey) - i) + 1))
    Next
    If Left(strCipher, Len(strCheckKey)) <> strCheckKey Then
        RaiseError errInvalidKey, "Invalid Key"
		DecryptText = -1
		Exit Function
    Else
        lngCipherPosition = (Len(strCheckKey) / 2) + 1
    End If
    lngPosition = 1
    bySerialLength = byCipher(lngCipherPosition) Xor byKey(lngPosition)
    lngCipherPosition = lngCipherPosition + 1
    lngPosition = lngPosition + 1
    For i = 1 To bySerialLength
        strTimeSerial = strTimeSerial & Chr(byCipher(lngCipherPosition) Xor byKey(lngPosition))
        If lngPosition = UBound(byKey) Then
			lngPosition = 1
        Else
            lngPosition = lngPosition + 1
        End If
        lngCipherPosition = lngCipherPosition + 1
    Next
    lngPosition = 1
    lngSerialPosition = 1
    ReCenter CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1))
    lngPosition = lngPosition + 1
    lngSerialPosition = lngSerialPosition + 1
    blnSecondValue = False
    For i = 1 To UBound(byCipher) - lngCipherPosition + 1
		If blnSecondValue = False Then
			Generate CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1)), False
			strClear = strClear & Chr(byCipher(lngCipherPosition) Xor MakeRandom(dblCenterX, 255))
			blnSecondValue = True
           Else
			strClear = strClear & Chr(byCipher(lngCipherPosition) Xor MakeRandom(dblCenterY, 255))
			blnSecondValue = False
           End If
           If lngPosition = UBound(byKey) Then
			lngPosition = 1
           Else
			lngPosition = lngPosition + 1
           End If
           If lngSerialPosition = Len(strTimeSerial) Then
               lngSerialPosition = 1
           Else
               lngSerialPosition = lngSerialPosition + 1
           End If
           lngCipherPosition = lngCipherPosition + 1
    Next
    LastResult = strClear
    DecryptText = 1
    Exit Function
End Function


Function NumToHex(bByte)
    Dim strOne
    Dim strTwo
    strOne = CStr(Int((bByte / 16)))
    strTwo = bByte - (16 * strOne)
    If CDbl(strOne) > 9 Then
        If CDbl(strOne) = 10 Then
            strOne = "A"
        ElseIf CDbl(strOne) = 11 Then
            strOne = "B"
        ElseIf CDbl(strOne) = 12 Then
            strOne = "C"
        ElseIf CDbl(strOne) = 13 Then
            strOne = "D"
        ElseIf CDbl(strOne) = 14 Then
            strOne = "E"
        ElseIf CDbl(strOne) = 15 Then
            strOne = "F"
        End If
    End If

    If CDbl(strTwo) > 9 Then
        If strTwo = "10" Then
            strTwo = "A"
        ElseIf strTwo = "11" Then
            strTwo = "B"
        ElseIf strTwo = "12" Then
            strTwo = "C"
        ElseIf strTwo = "13" Then
            strTwo = "D"
        ElseIf strTwo = "14" Then
            strTwo = "E"
        ElseIf strTwo = "15" Then
            strTwo = "F"
        End If
    End If
    NumToHex = Right(strOne & strTwo, 2)
End Function

Function HexToNum(hexnum)
	Dim X
	Dim y
	Dim cur
    hexnum = UCase(hexnum)
    cur = CStr(Right(hexnum, 1))
	Select Case cur
        Case "A"
            y = A
        Case "B"
            y = B
        Case "C"
            y = C
        Case "D"
            y = D
        Case "E"
            y = E
        Case "F"
            y = F
		Case Else
            y = CDbl(cur)
	End Select    
    Select Case Left(hexnum, 1)
        Case "0"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "1"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "2"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "3"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "4"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "5"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "6"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "7"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "8"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "9"
            X = (16 * CInt(Left(hexnum, 1))) + y
        Case "A"
            X = 160 + y
        Case "B"
            X = 176 + y
        Case "C"
            X = 192 + y
        Case "D"
            X = 208 + y
        Case "E"
            X = 224 + y
        Case "F"
            X = 240 + y
    End Select
	HexToNum = X
End Function
End Class
%>

<%
'------------------------------------------------
'EXEMPLO DE CHAMADA
'------------------------------------------------
Dim objCriptografia
Set objCriptografia = New Criptografia
Response.Write "Encriptação: " & objCriptografia.QuickEncrypt("CodigoFonte", "minhachave")
Response.Write "<br />Decriptação: " & objCriptografia.QuickDecrypt(objCriptografia.QuickEncrypt("CodigoFonte", "minhachave"), "minhachave")
Set objCriptografia = Nothing
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

xanburzum

Pesquisei no lab..

Inclusive em quase todos os posts que você publicou comentou. Até aquele do RC4...

por causa do seu post : http://forum.imasters.com.br/topic/391889-criptografia-de-url-em-asp/

 

 

Mas nada rolou.

 

Meu!

só preciso de algo que tenha chave, não use caracteres especiais.. Apenas letras e numeros.

 

Vou testar novamente suas sugestões

 

Abraço

 

JGD

 

xanburzum

 

1ª função... Veja o que novagador imprime:

 

navega.jpg

 

Não deveria escrever algo: aAJDS23saAsa...?

 

xanburzum,

 

A classe rolou assim:

 

navega2.jpg

 

Cara é bem complexa... "Vai ser bem complicado fazer equivalente em php... Pelo menos pra mim. (rs)

 

 

Aquela sua do

for i = 1 to len(str)

newStr = newStr & chr((asc(mid(str,i,1))+offset))

next

 

 

Não dariam para limitar em uma faixa de ASCII E com chave?

 

JGD

Compartilhar este post


Link para o post
Compartilhar em outros sites

olha este outro exemplo:

 

chave com comprimento de 512 bytes, criptografar/decriptografar strings e dados

 

<%
' Local onde a chave será criada
Const KeyLocation = "C:\chave.txt"

' Tamanho da gerada em bytes
Const KeyLen = 512

On Error Resume Next

Call WriteKeyToFile(KeyGeN(KeyLen),KeyLocation)

Response.Write "CHAVE GERADA COM SUCESSO."

Sub WriteKeyToFile(MyKeyString,strFileName)
Dim keyFile, fso
set fso = Server.CreateObject("scripting.FileSystemObject")
set keyFile = fso.CreateTextFile(strFileName, true)
keyFile.WriteLine(MyKeyString)
keyFile.Close
End Sub

Function KeyGeN(iKeyLength)
Dim k, iCount, strMyKey
lowerbound = 35
upperbound = 96
Randomize
for i = 1 to iKeyLength
s = 255
k = Int(((upperbound - lowerbound) + 1) * Rnd + lowerbound)
strMyKey = strMyKey & Chr(k) & ""
next
KeyGeN = strMyKey
End Function
%>

 

Acabamos de gerar um chave que foi salva no arquivo c:\chave.txt.

 

Agora vamos ao código necessário para criptografar dados de um usuário:

 

<%
Dim Key

Const CryptDados = "Now is the time for all good men to come to the aid of their country."
Const KeyLocation = "c:\chave.txt"

Key = mid(ReadKeyFromFile(KeyLocation),1,Len(CryptDados))

Response.Write "<p>FRASE ORIGINAL: " & CryptThis & "<p>"
Response.Write "<p>VALOR DA CHAVE: " & Key & "<p>"
Response.Write "<p>ENCRYPTED FRASE: " & EnCrypt(CryptThis) & "<p>"
Response.Write "<p>DECRYPTED FRASE: " & DeCrypt(EnCrypt(CryptThis)) & "<p>"

Function EnCrypt(strCryptThis)
Dim strChar, iKeyChar, iStringChar, i
for i = 1 to Len(strCryptThis)
iKeyChar = Asc(mid(Key,i,1))
iStringChar = Asc(mid(strCryptThis,i,1))
' iCryptChar = iStringChar + iKeyChar
iCryptChar = iKeyChar Xor iStringChar
strEncrypted = strEncrypted & Chr(iCryptChar)
next
EnCrypt = strEncrypted
End Function

Function DeCrypt(strEncrypted)
Dim strChar, iKeyChar, iStringChar, i
for i = 1 to Len(strEncrypted)
iKeyChar = (Asc(mid(Key,i,1)))
iStringChar = Asc(mid(strEncrypted,i,1))
' iDeCryptChar = iStringChar - iKeyChar
iDeCryptChar = iKeyChar Xor iStringChar
strDecrypted = strDecrypted & Chr(iDeCryptChar)
next
DeCrypt = strDecrypted
End Function

Function ReadKeyFromFile(strFileName)
Dim keyFile, fso, f
set fso = Server.CreateObject("Scripting.FileSystemObject")
set f = fso.GetFile(strFileName)
set ts = f.OpenAsTextStream(1, -2)

Do While not ts.AtEndOfStream
keyFile = keyFile & ts.ReadLine
Loop

ReadKeyFromFile = keyFile
End Function
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pessoal conseguiu.

 

Baseado em um post de um outro fórum...

O script do rapaz de lá me salvou. Crédito para o Cyber Eye.

 

 

Ele vez + ou - assim:

 

Definiu uma faixa de valores de 3 caracteres pré-definidos para cada letra e numero a ser tratado.

 

Ex:

a = “d4c”

s = “1ab”

p = “5lk”

 

 

Via função (que recebe a string a ser tratada)

Ele vare cada item da string via for next trocando a ocorrencia encontrada em uma das faixas (sequecia de caracteres) estabelecidas… E assim cria a codificação da informação.

 

Ex:

Faixa:

a = “d4c”

s = “1ab”

p = “5lk”

 

Palavra = “asp”

Palavra codificada: d4c1ab5lk

 

Para decodificar basta separar a string conform o tamnho da faixa estabelecida e reverter a conversão.

 

A vantagem é que podemos personalizar a faixa e os caracteres trabalhandos conforme desejarmos (inclusive em Php tb que é preciso também)…

 

Então fica +ou - o caminho das pedras.

 

Abraço

 

JGD

Compartilhar este post


Link para o post
Compartilhar em outros sites

legal, na verdade existem várias formas para se fazer, e para auxilio de outros users, se quiser poste seu code como ficou.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.