[Resolvido] Função para criptografar 128 bits com escolha de cara

[Geovane Velmer 0]

Galera eu estou tentando gerar um serial para liberação da aplicação por periodo,

e quero passar isso pro cliente criptografado

 

ex: Data-> 04/02/2010 Serial HD-> 8425F9D Restante em Dias -> 030 = 040220108425F9D030

 

Criptografado com letras de A a Z Maiusculas e números de 0 a 9

 

A8GN4 - KJD9S - 72E4B - 63WLB

 

Algo parecido com isso.. alguem tem alguma função que possa me passar ou até um ideia melhor ?

Aguardo uma ajuda de vcs..

 

Att+ e abraços!

[Fabriciocbj 0]

Amigo Geovane,

de uma olhada nesta função que criei, ela criptografa os dados. Caso você queira colocar algum parâmetro fixo, é só colocar mais um parâmetro e fazer a mesma coisa quando for descriptografar.

function Criptografar(const InString : string; Dia, Mes, Ano : Integer) : string;
  var I : Byte;
begin
  Result := '';
  for I := 1 to Length(InString) do
    begin
      Result := Result + CHAR(Byte(InString[I]) xor (Dia shr 8));
      Dia := (Byte(Result[I]) + Dia) * Mes + Ano;
    end;
end;

[Igor Bastos 0]

Cara essa função é grande mas é otima:

 

function Crypt(Action, Src: String): String;
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 := 'YUQL23KL23DF90WI5E1JAS467NMCXXL6JAOAUWWMCL0AOMM4A4VZYW9KHJUI2347EJHJKDF3424SKL K3LAKDJSL9RTIKJ';
	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;

*************************

 

Usa-se C para Criptografar e D para Descriptografar

Ex de Criptografia:

Edit2.text:= Crypt('C',Edit1.text);

 

*************************

 

Ex: de Descriptografia

Edit3.text:= Crypt('D',Edit2.text);

 

 

Espero que tenha gostado

[ispiriquidiberto 0]

Fala ae galera...

Não sei se é de interesse usar um componente para fazer esse serviço, mas caso seja, sugiro o TPLockBox:

http://sourceforge.net/projects/tplockbox/

 

Precisamos utilizar criptografia em uma aplicação e esse componente serviu como uma luva... FREE

 

Dêem uma olhada caso interesse.

Espero ter sido útil.

 

Abrax

[Geovane Velmer 0]

Cara essa função é grande mas é otima...

 

Vlw cara, muito boa essa função! Resolveu o meu problema.

 

Obrigado.

[darth maul 0]

Bom dia!

 

Não estou conseguindo descriptografar!

 

Na linha "OffSet := StrToInt(' + copy(Src,1,2));" troquei para "OffSet := StrToInt('' + copy(Src,1,2));"

e na linha "SrcAsc := StrToInt(' + copy(Src,SrcPos,2));" troquei por "SrcAsc := StrToInt('' + copy(Src,SrcPos,2));"

mas dá o seguinte erro:

'EA' is not a valid integer value

 

Quando ele criptografa por exemplo o Numero 1, virou a cadeia EA45, depois na hora de descriptografar ele dá essa menssagem.

 

Obrigado

[Marcelo Leão 0]

Amigo Geovane,

de uma olhada nesta função que criei, ela criptografa os dados. Caso você queira colocar algum parâmetro fixo, é só colocar mais um parâmetro e fazer a mesma coisa quando for descriptografar.

function Criptografar(const InString : string; Dia, Mes, Ano : Integer) : string;
  var I : Byte;
begin
  Result := '';
  for I := 1 to Length(InString) do
    begin
      Result := Result + CHAR(Byte(InString[I]) xor (Dia shr 8));
      Dia := (Byte(Result[I]) + Dia) * Mes + Ano;
    end;
end;

Tenho um código parecido com esse, na verdade peguei da internet. Quando a função "CHAR(Byte(InString) xor (Dia shr 8))" retorna "#13" que é o códito do return (enter) isso gera um problema na hora de decriptografar, pois o caracter que representa o #13 não é "imprimível". Então acredito que esta função tem um bug. Alguém já passou por isso?

[F3rn4nd0TF 0]

function Crypt(Action, Src: String): String;
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 := 'AQUI VOCE CRIA SUA CHAVE PARA CRIPTOGRAFAR';
       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));//<--------------- adiciona o $ entra as aspas simples
               SrcPos := 3;
               repeat
                       SrcAsc := StrToInt('$' + copy(Src,SrcPos,2));//<--------------- adiciona o $ entra as aspas simples
                       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;

 

CORREÇÃO DO CÓDIGO