



Obs. (*
Esta função só funciona com caracteres, números ela não se aplica!
*)
Abaixo seguem 3 funcoes, a primeira retorna o código ASCII de cada
caracter, a segunda Criptografa uma string e a terceira descriptografa.
Voce pode sempre mudar a chave como preferir.
Espero ter sido de ajuda. Autor Original: M C Zanetti
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | //funcao que retorno o código ASCII dos caracteres function AsciiToInt(Caracter: Char): Integer; var i: Integer; begin i := 32; while i < 255 do begin if Chr(i) = Caracter then Break; i := i + 1; end; Result := i; end; { Esta funcao tem como objetivo criptografar uma string utilizando o código ASCII de cada caracter e somando a esse código o valor da CHAVE} Function Criptografa(texto:string;chave:integer):String; var cont:integer; retorno:string; begin if (trim(texto)=EmptyStr) or (chave=0) then begin result:=texto; end else begin retorno:=''; for cont:=1 to length(texto) do begin retorno:=retorno+chr(asciitoint(texto[cont])+chave); end; result:=retorno; end; end; { Esta funcao é semelhante a funcao de Criptografia mais com o objetivo de descriptografar a string } Function DesCriptografa(texto:string;chave:integer):String; var cont:integer; retorno:string; begin if (trim(texto)=EmptyStr) or (chave=0) then begin result:=texto; end else begin retorno:=''; for cont:=1 to length(texto) do begin retorno:=retorno+chr(asciitoint(texto[cont])-chave); end; result:=retorno; end; end; |
{ Exemplo de Utilização das funcoes }
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | // Criptografando procedure TForm1.Button1Click(Sender: TObject); begin showmessage(Criptografa('showdelphi.com.br', 100)); end; // Descriptografando procedure TForm1.Button2Click(Sender: TObject); var vText : string; begin vText := Criptografa('showdelphi.com.br', 100); showmessage(DesCriptografa(vText, 100)); end; |
Fonte base: http://www.planetadelphi.com.br/dica/7583/-funcao-para-criptografar-e-descriptografar-uma-string-