criptografia de senha

unit UDefinedCrypt;
{ 21/09/2002
  DefinedCrypt versão 1.0 FINAL (não pretendo mais modificar)
  By Carlos Barreto Feitoza Filho tcc Ðerek Wildstar (ICQ#29391688)
  afmdkqc@ieg.com.br
  ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  História:
  Um dia precisei de um algoritmo simples de criptografia para usar
  em  um de meus programas,  com o intuito  de encriptar strings de
  texto. Como não tive paciência para criar um, resolvi procurar na
  Internet. Achei o que eu estava procurando, mas ocorreu uma coisa
  muito  inesperada...  O  agorítmo  era  genérico,  ou  seja,  ele
  manipulava  a  sequencia de  texto  entrada  e  fazia um  cálculo
  simples, alterando os caracteres um a um. Isso seria o ideal, mas
  infelizmente  ele  utilizava todos os  256 caracteres do conjunto
  ASCII, quer  dizer, ele também incluía  em seus cálculos todos os
  caracteres de controle  (DEL, CR, LF,  ACK, etc.).  Descobri isso
  quando encriptava uma string que seria salva em um INI. Quando eu
  a decriptava  ela sempre vinha  pela metade e  dava um puta erro!
  Foi então que eu percebi o que etava acontecendo: A String que eu
  estava  processando,  gerava  após ser  encriptada  um  caractere
  especial  (CR). Como nos INIs se salvam uma linha de cada vez, eu
  só estava  salvando a string até o CR e  o que vinha após ele era
  sumariamente  ignorado.  Foi então que eu lembrei  do JavaScript!
  Em  JS tem muitos exemplos pra fazer  criptografia  de strings, e
  além  disso, como  JS não é  uma linguagem  compilada  e  sim uma
  Linguagem Interpretada seria  muito mais fácil encontrar o que eu
  procurava. Esse  módulo, portanto,  foi INTEIRAMENTE convertido e
  otimizado  a partir  do Script  VIRGENERE  ENCRYPTION  criado por
  Francisco  Ryan  Tolmasky (opossum@mailcity.com)  No  final dessa
  unidade  encontra-se  o  bloco JS original!  Esse  Script usa uma
  tabela  fixa  (Array  de Strings)  contendo  pares  de caracteres
  comuns em  meu idioma,  nunca saindo desse intervalo, ou seja, as
  funções  só  usam esses  caracteres  para criptografar ficando de
  fora  caracteres  indesejados!  Esse  script  está  longe  de ser
  seguro, mas serve a muitos propósitos!

  Uso:
  Simplesmente inclua essa unidade no seu projeto:
  Project->Add To Project

  Em seguida Basta utilizar a função:

  EncryptDecrypt(Senha, Entrada: String; Funcao: Char): String;
  A função retorna a String ´Entrada´ (de)criptada de acordo com
  a string ´Senha´

  Senha = Uma sequencia de texto que tem de ser a mesma quando  for
  feita a decriptação. Por isso o nome de SENHA!
  Entrada = String de Texto a ser (de)criptada (2GB Max)
  Função = Letra que identifica o processo a ser usado pela  função.
   Pode ser ´E´ para encriptar ou ´D´ para decriptar!

}

{$DEFINE EXTENDED}
interface

uses
Forms;

function EncryptDecrypt(Senha, Entrada: String; Funcao: Char): String;

const
{$IFDEF EXTENDED}
CryptTable: array[0..78] of string = (´ 1´,´@2´,´3´,´ª4´,´º5´,
´¨6´,´&7´,´*8´,´(9´,´)0´,´_-´,´+=´,´{[´,´}]´,´|\´,´<,´,´>.´,´:;´,´°/´,
´!¡´,´?¿´,´¬‰´,´€¥´,´&$´,´Çç´,´Aa´,´Àà´,´Áá´,´Ââ´,´Ãã´,´Ää´,´Åå´,´Bb´,
´Cc´,´Dd´,´Ee´,´Èè´,´Éé´,´Êê´,´Ëë´,´Ff´,´Gg´,´Hh´,´Ii´,´Ìì´,´Íí´,´Îî´,
´Ïï´,´Jj´,´Kk´,´Ll´,´Mm´,´Nn´,´Ññ´,´Oo´,´Òò´,´Óó´,´Ôô´,´Õõ´,´Öö´,´Pp´,
´Qq´,´Rr´,´Ss´,´Šš´,´Tt´,´Uu´,´Ùù´,´Úú´,´Ûû´,´Üü´,´Vv´,´Ww´,´Xx´,´Yy´,
´Ýý´,´Ÿÿ´,´Zz´,´Žž´);
{$ELSE}
CryptTable: Array[0..35] of string = (´0@´,´1´,´2$´,´3¬´,´4^´,´5&´,´6*´,´7 = ´,´8-´,´9+´,´Aa´,´Bb´,´Cc´,´Dd´,´Ee´,´Ff´,´Gg´,´Hh´,´Ii´,´Jj´,´Kk´,´Ll´,´Mm´,´Nn´,´Oo´,´Pp´,´Qq´,´Rr´,´Ss´,´Tt´,´Uu´,´Vv´,´Ww´,´Xx´,´Yy´,´Zz´);
{$ENDIF}
implementation

function EncryptDecrypt(Senha, Entrada: String; Funcao: Char): String;
var
IndiceFinalSenha, IndiceEntrada, IndiceSenha: Integer;
StringTemporaria: String;
X, Shift, OriginalIndex: Byte;
//----
function GetIndexFromPair(Letra: ShortString): Byte;
var
i: Byte;
begin
for i := 0 to High(CryptTable) do
begin
Application.ProcessMessages;
if Copy(CryptTable[i],1,1) = Letra then
begin
X := 1;
result := i;
Break;
end
else if Copy(CryptTable[i],2,1) = Letra then
begin
X := 2;
result := i;
Break;
end;
   end;
end;

function CheckIfExist(Letra: ShortString): Boolean;
var
i: Byte;
begin
result := False;
for i := 0 to High(CryptTable) do
begin
Application.ProcessMessages;
if (Copy(CryptTable[i],1,1) = Letra) or (Copy(CryptTable[i],2,1) = Letra) then
begin
result := True;
Break;
end;
end;
end;
// A funcao abaixo mantem os procedimentos sempre atuando no
// intervalo de 0 a High(CryptTable), Retornando um valor nesse
// intervalo
function FixOffset(Indice: Byte): Byte;
begin
if Indice > High(CryptTable) then Result := (Indice - (High(CryptTable) + 1))
else Result := Indice;
end;
//----
begin
IndiceFinalSenha := Length(Senha); //Indice do ultimo caractere na Senha
IndiceEntrada := 1; //Armazena o indice na strinde de entrada
IndiceSenha := 1; //Armazena o indice na sring de senha
StringTemporaria := ´´; //String com a string a ser (des)criptografada
//====
Repeat
    Application.ProcessMessages;
if CheckIfExist(Copy(Entrada,IndiceEntrada,1)) then
begin
if CheckIfExist(Copy(Senha,IndiceSenha,1)) then
begin
//encode (E) e dencode (D)
if Funcao = ´E´ then Shift := GetIndexFromPair(Copy(Senha,IndiceSenha,1))
else if Funcao = ´D´ then Shift := (High(CryptTable) + 1) - GetIndexFromPair(Copy(Senha,IndiceSenha,1));
end
else Shift := 0;
OriginalIndex := GetIndexFromPair(Copy(Entrada,IndiceEntrada,1));
StringTemporaria := StringTemporaria + Copy(CryptTable[FixOffset(OriginalIndex+Shift)],X,1);
end//Abaixo: Se a letra nao existe na tabela, ela será repetida
else StringTemporaria := StringTemporaria + Copy(Entrada,IndiceEntrada,1);
Inc(IndiceEntrada);
if IndiceSenha = IndiceFinalSenha then IndiceSenha := 1
else Inc(IndiceSenha);
Until IndiceEntrada = Length(Entrada)+1;
Result := StringTemporaria;
end;
end.