como faço para criar senha instalação e senha de validação

Delphi

15/10/2004

como faço para criar senha instalação e senha de validação
eu preciso criar um serial para a instalação do programa e outra para validação depois de instalado


Romano

Romano

Curtidas 0

Respostas

Jose Almeida

Jose Almeida

15/10/2004

{Pega o serial do HD}

function SerialNum(FDrive:String) :String;
var
Serial:DWord;
DirLen,Flags: DWord;
DLabel : Array[0..11] of Char;
begin
try
GetVolumeInformation(PChar(FDrive+´:\´),dLabel,12,@Serial,DirLen,Flags,nil,0);
Result := IntToHex(Serial, 8 );
except Result :=´´;
end;
end;

{Gera um código alfanumérico a partir de um string,
no caso o serial do HD}

Function Rsn(cad: string): string;
var
chv,cod,aux:string;
x,y,w,sm:integer;
nr: array[1..105] of integer;
pd: array[1..105] of integer;
begin
result:=´´;
cod:= ´369ADGJMPSVYX147BEHKNQTWZ258CFILRUadgjmpsvyxbehknqtwzcfiloru´;{mude isto}
chv:=´69ADGJMPSVYX147BEHKNQTWZ258CFILRU369VYX147BEHKNQTWZ258CFILRU3´;{mude isto}
aux:= cad+cod+cod;
for y:=1 to 100 do
begin
x:=0;
repeat
x:=x+1;
until ((aux[y]=cod[x])or(x=60));
nr[y]:=x;
end;
y:=100;sm:=0;
for x:=1 to 10 do {Código de 10 dígitos. Pode mudar}
begin
for w:=1 to y do
begin
pd[w]:=nr[w]*(y-w+2);sm:=sm+pd[w];
end;
sm:= 1+(sm mod 61);
result:=result+chv[sm];
y:=y+1;nr[y]:=sm;sm:=0;
end;
end;


procedure TForm1.FormActivate(Sender: TObject);
begin
Edit1.Text:=(Rsn(SerialNum(´C´))); {Pública}
Label1.caption:= Rsn(Edit1.Text); {Senha Secreta}
end;

{Para testar, digite no Edit2 o que esta no Label1}

procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit2.Text=Rsn(Edit1.Text)then
ShowMessage(´Senha Confere´)else
ShowMessage(´Senha Não Confere´);
end;


GOSTEI 0
Jose Almeida

Jose Almeida

15/10/2004

Melhorando o código:

{Gera um código alfanumérico a partir de um string}

function GeraCod(Cad: string): string;
var
Chave,Cod:string;
x,y,w,Sm:integer;
Nr: array[1..105] of integer;
Pd: array[1..105] of integer;
begin
Result:=´´;
Chave:=´EjHlKoNrQTWgZy´; //Mude isto.
for x:=65 to 90 do Cod:=Cod+Chr(x)+Chr(187-x);
for x:=1 to 10 do Cod:=Cod+Chr(58-x);
Cod:=Cod+Cod;
Cad:=Chave+Cad+Cod;
for y:=1 to 100 do
begin
x:=0;
repeat
x:=x+1; // Posição do caracter da Cad no Cod
until ((Cad[y]=Cod[x])or(x=60));
Nr[y]:=x; // Da nr ao caracter conf sua posição no Cod
end;
Sm:=0;
y:=100;
Cod:=´69ADGJMPSVYX147BEHKNQOTWZ258CF0ILRU3´; //Associa um caracter ao valor Sm.
for x:=1 to 7 do //Código de 7 dígitos. Pode ser mudado
begin
for w:=1 to y do
begin
Pd[w]:=Nr[w]*(y-w+2);
Sm:=Sm+Pd[w];
end;
Sm:=1+(Sm mod 36);
Result:=Result+Cod[Sm];
y:=y+1;Nr[y]:=Sm;
Sm:=0;
end;
end;


GOSTEI 0
Jose Almeida

Jose Almeida

15/10/2004

{Gera uma chave do tipo: EERF-9XPP-X3XX }

function GeraCod(Cad: string):string;
const
Chave:string = ´j5Klm2hUV4A´;
var
Cod:string;
Pdt,Sm,x,y,w:integer;
Psc: array[1..100] of integer;
begin
for x:=1 to 26 do Cod:=Cod+Chr(64+x)+Chr(123-x);
Cad:=Chave+Cad;
Cod:=Cod+Cad;
for y:=1 to Length(Cad) do
begin
x:=0;
repeat x:=x+1;
until Cad[y]=Cod[x];
Psc[y]:=x;
end;
Sm:=0;
Result:=´´;
y:=Length(Cad);
Cod:=´69ADGJMPSVYX147BEHKNQOTWZ258CF0ILRU3´;
for x:=1 to 4 do
begin
for w:=1 to y do
begin
Pdt:=Psc[w]*(y-w+2);
Sm:=Sm+Pdt;
end;
Sm:=(Sm mod 36)+1;
Result:=Result+Cod[Sm];
y:=y+1;
Psc[y]:=Sm;
Sm:=0;
end;
end;

function GeraSenha(Str: string): string;
begin
Result:=GeraCod(Str);
Result:=Result+´-´+GeraCod(Result);
Result:=Result+´-´+GeraCod(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text:=GeraSenha(´STRING´);
end;


GOSTEI 0
POSTAR