criptografia

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;

    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses Registry;

{$R *.dfm}

function MySystemDirectory: string;
var
  buff: array[0..255] of char;
begin
  GetSystemDirectory(buff, 254);
  Result := StrPas(buff);
end;

Function Tri(Action, Src: String): String;
{Action = (C-Criptografar, D-Descriptografar)}
Label Fim;
  var
    KeyLen : Integer;
    KeyPos : Integer;
    OffSet : Integer;
    Dest, Key : String;
    SrcPos : Integer;
    SrcAsc : Integer;
    TmpSrcAsc : Integer;
    Range : Integer;
begin
  if (Src = '') Then
  begin
    Result:= '';
    Goto Fim;
  end;
  Key :='ABCDEFGHIJKLMNOPQRSTUVXYWZ0987654321 YUQL23KL23DF90WI5E1JAS467NMCXXL6JAOAUWWMCL0AOMM4A4VZYW9KHJUI2347EJHJKDF3424SKL K3LAKDJSL9RTIKJABCDEFGHIJKLMNOPQRSTUVXYWZ0987654321';
  Dest := '';
  KeyLen := Length(Key);
  KeyPos := 0;
  SrcPos := 0;
  SrcAsc := 0;
  Range := 256;
  if (Action = UpperCase('C'))
  then
    begin
      Randomize;
      OffSet := Random(Range);
      Dest := Format('%1.2x',[OffSet]);
      for SrcPos := 1 to Length(Src) do
      begin
        Application.ProcessMessages;
        SrcAsc := (Ord(Src[SrcPos]) + OffSet) Mod 255;
        if KeyPos < KeyLen then KeyPos := KeyPos + 1 else KeyPos := 1;
        SrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
        Dest := Dest + Format('%1.2x',[SrcAsc]);
        OffSet := SrcAsc;
      end;
    end
  Else
    if (Action = UpperCase('D')) then
    begin
      OffSet := StrToInt('$'+ copy(Src,1,2));
      SrcPos := 3;
      repeat
        SrcAsc := StrToInt('$'+ copy(Src,SrcPos,2));
        if (KeyPos < KeyLen) Then KeyPos := KeyPos + 1 else KeyPos := 1;
        TmpSrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
        if TmpSrcAsc <= OffSet
        then
          TmpSrcAsc := 255 + TmpSrcAsc - OffSet
        else
          TmpSrcAsc := TmpSrcAsc - OffSet;
        Dest := Dest + Chr(TmpSrcAsc);
        OffSet := SrcAsc;
        SrcPos := SrcPos + 2;
      until (SrcPos >= Length(Src));
  end;
  Result:= Dest;
  Fim:
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text := Tri('C', 'texto normal');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
edit2.text := Tri('D', 'texto encript'); //descript
end;

end.