Mega Code Archive
Registration routine (creating a shareware application)
<![CDATA[
Title: Registration routine (creating a shareware application)
Question: How can I create a registration routine?
Answer:
{
Author: Cosmin Prlitu
E-mail: cosmin.pirlitu@mail.com
The following code uses two edit boxes (edtName and edtEmail) to generate a *case-sensitive* serial number for shareware applications.
You also need to place a button (btnRegister) and a third edit box (edtSerial) on the form (frmRegister).
When the user clicks on the "Register" button the program calculates the serial number and compares it with the serial entered in the "Serial Number" box.
If the values are the same then the code is accepted and program is registered otherwise the code is treated as invalid and the program remains unregistered.
The code above was written in Notepad and was not tested!
I appologise for eventual spelling errors...
}
uses StrUtils;
{...code...}
function TfrmRegister.EncodeString(Value: string): string;
var i: integer;
begin
Result:='';
for i:=0 to Length(Value)-1 do
Result:=Result+IntToStr(VKKeyScan(Value[i]));
end;
function TfrmRegister.GenerateSerial(Name, Email: string): string;
begin
Result:=EncodeString(Name)+ReverseString(EncodeString(Email));
end;
{...code...}
procedure TfrmRegister.btnRegisterClick(Sender: TObject);
var tempSerial: string;
begin
if (((Length(edtName.Text0)) and (Length(edtEmail0))) then
begin
tempSerial:=GenerateSerial(edtName.Text, edtEmail.Text);
if tempSerial=edtSerial.Text then
begin
MessageDlg('Code accepted!'+#13+
'The program is now registered to '+edtName.Text+'...',
mtInformation,[mbOK],0);
{ save the registration details and stop trial/nag-screen }
end
else begin
MessageDlg('Invalid code!'+#13+
'Remember that the Name and E-mail are case-sensitive!',
mtWarning,[mbOK],0);
Exit;
{ serial is invalid so the program is still shareware/trial }
end;
end
else begin
MessageDlg('Please provide a valid Name and E-mail address...',
mtWarning,[mbOK],0);
Exit;
end;
end;
]]>