TyttoSoft

DICAS | SOFTWARE | PROGRAMAÇÃO | OPORTUNIDADE



Criptografando e descriptografando senha



  

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





21/08/2018 20:55 Lazarus 588


loading...

Copyright © TyttoSoft 2018 | Desenvolvido por www.TyttoSoft.com.br