Vou esta mostrando como criptografar uma senha
e descriptografar.
Vamos criar um novo projeto:
Projeto > Novo Projeto
Na propriedade do form
Heigth : 194
Width : 520
Vamos adicionar
4 Edit, 4 Label e 2 Button localizados na paleta Standard
Vamos mudar a propriedade Name dos buttons
1º edtcriptografado
2º edtdescrptografado
3º edttexto
4º edtkey
Vamos colocar cada um dos Label para cada Edit
vamos também mudar propriedade caption dos label.
1º Criptografado.
2º Descriptografado
3º Texto
4º Key (6 digitos)
na propriedade MaxLength do Edit edtkey coloque número
6 porque não passara de 6 dígitos o texto.
deve ficar conforme imagem:
![]()
a baixo de private vamos criar nossa função
function criptografar(const key, texto:String):String;
function descriptografar(const key, texto:String):String;
em seguida clique em Ctrl + Shift + C
a função criptografar ficara assim
function TForm1.criptografar(const key, texto: String): String;
var
I: Integer;
C: Byte;
begin
Result := '';
for I := 1 to Length(texto) do begin
if Length(Key) > 0 then
C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(texto[I])
else
C := Byte(texto[I]);
Result := Result + AnsiLowerCase(IntToHex(C, 2));
end;
end;
Já a função descriptografar
function TForm1.descriptografar(const key, texto: String): String;
var
I: Integer;
C: Char;
begin
Result := '';
for I := 0 to Length(texto) div 2 - 1 do begin
C := Chr(StrToIntDef('$' + Copy(texto, (I * 2) + 1, 2), Ord(' ')));
if Length(Key) > 0 then
C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
Result := Result + C;
end;
end;
Agora vamos ao button criptografar seleciona ele e no Evento OnClick
de um clique duplo em seguida escreva o código:
edtcriptografado.Text:=criptografar(edtkey.Text,edttexto.Text);
e no button descriptografar no evento OnClick colocamos o código:
edtdescriptografado.Text:=descriptografar(edtkey.Text, edtcriptografado.Text);
Agora vamos testar clicando em F9 assim que sistema abrir informe o Key
e só colocar o texto a ser criptografado e descriptografado.
![]()
Nossa Unit deve ficar da seguinte forma:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms,
Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
edtcriptografado: TEdit;
edttexto: TEdit;
edtdescriptografado: TEdit;
edtkey: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function criptografar(const key, texto:String):String;
function descriptografar(const key, texto:String):String;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
edtcriptografado.Text:=criptografar(edtkey.Text,edttexto.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
edtdescriptografado.Text:=descriptografar(edtkey.Text,
edtcriptografado.Text);
end;
function TForm1.criptografar(const key, texto: String): String;
var
I: Integer;
C: Byte;
begin
Result := '';
for I := 1 to Length(texto) do begin
if Length(Key) > 0 then
C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(texto[I])
else
C := Byte(texto[I]);
Result := Result + AnsiLowerCase(IntToHex(C, 2));
end;
end;
function TForm1.descriptografar(const key, texto: String): String;
var
I: Integer;
C: Char;
begin
Result := '';
for I := 0 to Length(texto) div 2 - 1 do begin
C := Chr(StrToIntDef('$' + Copy(texto, (I * 2) + 1, 2), Ord(' ')));
if Length(Key) > 0 then
C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
Result := Result + C;
end;
end;
end.
Link para Download Fontes