26

Re: 30-Day Trial and Purchase

Papafrankc,

In the code you provided, you haven't assigned the text in your edit box to sKey.

Assuming you have sKey as a string type variable you need -

sKey := formName.EditBoxName.text;
On a clear disk you can seek forever

Re: 30-Day Trial and Purchase

// процедура проверки регистрации
procedure registrKey;
var
   reg: TRegistry;
   iDays: integer;
   sKey: string;
begin
     sKey := '';
     reg := TRegistry.Create;
     reg.Access := KEY_ALL_ACCESS;
     reg.RootKey := HKEY_CURRENT_USER;
     reg.OpenKey('software\service', True);//+APP_NAME - имя вашей программы
     if not reg.ValueExists('StartDate') then reg.WriteDate('StartDate', Now+20); // демо версия (Now+20)=20 дней
     iDays := Trunc(reg.ReadDate('StartDate')) - Trunc(Now); // time left days
     sKey := reg.ReadString('Key');

     reg.CloseKey;
     reg.Free;

     if sKey=EncryptRC5(GetHardDiskSerial(ExtractFileDrive (paramstr(0))),'SibprogsistemKHMAONefteyugansk') then
     begin
        // настройте на свой вкус, что если программа зарегистрированна
         frmReg.gbMail.Visible:=false;
         frmReg.gbKey.Visible:=false;
         frmReg.bBuy.Visible:=false;
         frmReg.lOk.Visible:=True;
         frmServiceCen.Caption:=langIniG.ReadString('FrmCap','F_S_C_C', 'Сервисный центр');
         //frmServiceCen.tgList.Width:=1100;
         //frmServiceCen.pAdds.Visible:=False;
         frmServiceCen.lBlock_1.Visible:=False;
         frmServiceCen.lBlock_2.Visible:=False;
         frmServiceCen.lBlock_3.Visible:=False;

     end else begin
        if iDays < 1 then
            begin
             // настройте на свой вкус, что если закончился пробный период
              ShowMessage(langIniG.ReadString('message','00x44', 'Пробный период завершен!'));
              //frmServiceCen.tgList.Width:=800;
              //frmServiceCen.pAdds.Visible:=True;
              frmServiceCen.lBlock_1.Visible:=True;
              frmServiceCen.lBlock_2.Visible:=True;
              frmServiceCen.lBlock_3.Visible:=True;
              webAdds;
            end else
              // настройте на свой вкус, что если программа не зарегестрированна
              frmServiceCen.caption:=frmServiceCen.caption+' '+ langIniG.ReadString('message','00x45', 'Осталось')+ ' ' + IntToStr(iDays) +' '+ langIniG.ReadString('message','00x46', 'дней');
       end;
end;

Re: 30-Day Trial and Purchase

Hello papafranck

Once you have entered your key, you can check that this key is registered in the registry.
You launch RegEdit then you go to the HKEY_CURRENT_USER section then to the Software section and you check that where the name of your application appears your key is present (so is well written)

Go slowly if you make a mistake by hacking in the Base Registry, you can crash your system.

If you wan, you can save the registry first

JB

Re: 30-Day Trial and Purchase

CDB
It looks like it still is not saving the Key
Here's what I have:
procedure frmNagScreen_Button2_OnExit (Sender: TObject);
var
   reg: TRegistry;
   sKey : string;
begin
  sKey := frmNagScreen.skey.Text;
  reg.Access := KEY_ALL_ACCESS;
  reg.RootKey := HKEY_CURRENT_USER;
  reg.OpenKey('software\RecordsX.exe',true);
  Reg.WriteString('Key', 'sKey');
end;

-
I was getting an Undeclared Identifier so I added sKey : string;
Now I don't get the error but my NagScreen shows up when I re-open the project.
-
Thanks, Frank

Re: 30-Day Trial and Purchase

Hi sibprogsistem
I see your reply to my ongoing problem but I'm not sure what it means?
I don't recognize some of the code as applying to my procedure.
Are you sure it's for my code problem?
-
Thanks, Frank

Re: 30-Day Trial and Purchase

papafrankc wrote:

Hi sibprogsistem
I see your reply to my ongoing problem but I'm not sure what it means?
I don't recognize some of the code as applying to my procedure.
Are you sure it's for my code problem?
-
Thanks, Frank

это процедура проверки триала программы, взята из моего проекта, черновик проекта  вы можете скачать тут http://myvisualdatabase.com/forum/viewtopic.php?id=6853

 
1.программа просит указать mail  указанный при покупке лицензии
2. программа сверяет указанный mail с базой данных в интернете
3. если такой mail найден, то программа посылает пароль лицензии на mail
 
в качестве пароля используется зашифрованный номер системного диска

 
 
this is the procedure for checking the trial of the program, taken from my project, you can download the draft of the project herehttp://myvisualdatabase.com/forum/viewtopic.php?id=6853
 
 
1.the program asks for the mail specified when purchasing a license
2.the program checks the specified mail against the Internet database
3.if such a mail is found, then the program sends the license password to mail
 
the encrypted system disk number is used as the password

  вот полный код работы с лицензией программы
here is the complete code for working with the program license

procedure reegedit (Action:String);
 var
  reg : TRegistry;
begin
if Action='addAutorun' then  begin
    reg:= TRegistry.Create;
    reg.Access := KEY_ALL_ACCESS;
    reg.RootKey:= HKEY_CURRENT_USER;
    reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
    reg.WriteString('service', '"'+Application.ExeName+'"');
    reg.CloseKey;
    reg.Free;
  end;
if Action='deleteAutorun' then  begin
reg:= TRegistry.Create;
    reg.Access := KEY_ALL_ACCESS;
    reg.RootKey:= HKEY_CURRENT_USER;
    reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
    reg.DeleteValue('service');
    reg.CloseKey;
    reg.Free;
  end;
end;


// функция сравнения e-mail..
function CheckCSV(Str: string): boolean;
var
  sl: TStringList;
  p:string;
begin
  result := False;
  p:=DecryptRC5('476E68289553807E473EE519642111E9230FCD17CC12EBE4A6797'+
  '28ADC889CC9742FDBEEC5A4A0DE14687D9C2A40A154639859D09F6D6'+
  'F5ACF24D3BCEEAEC6B66E87BC67D4E73888EF6C34096DB12E6D34373'+
  'CDBCD4A10430000','passwordlistweb');
  sl := TStringList.Create;
  sl.Add('action=csv');
  sl.Add('password='+p);
  //загрузка текста csv файла. Укажите свой url адрес
  sl.text:=HTTPPOST('https://service-vv.ru/api/index.php',sl);
  // если e-mail есть в списке, вернуть правду
  if Pos(Str, sl.Text) > 0 then Result := True;
  sl.Free;
end;
// кнопка проверки e-mail адреса
procedure frmReg_bMail_OnClick (Sender: TObject; var Cancel: boolean);
begin
  if CheckCSV(frmReg.eMail.Text) then mailKey else ShowMessage(langIniG.ReadString('message','00x39', 'Указан не верный адрес электронной почты!'));
end;

//процедура отправки ключа
procedure mailKey;
var
sl: TStringList;
mmMessage,s, key: string;
begin
   sl := TStringList.Create;
   mmMessage:=langIniG.ReadString('message','00x73', 'Здравствуйте! Ваш ключ авторизации: ')+' '+EncryptRC5(GetHardDiskSerial(ExtractFileDrive (paramstr(0))),'SibprogsistemKHMAONefteyugansk');
   s:=mailerphp(frmReg.eMail.Text , langIniG.ReadString('message','00x74', 'Ключ авторизации') , mmMessage );
   sl.text:=(s);
   if Pos('Data restored', sl.Text) > 0 then showmessage(langIniG.ReadString('message','00x41', '') +frmReg.eMail.Text );
   sl.Free;
end;

function mailerphp (mailTo,Subject,mailMessage: string ): string;
var
    slParam: TStringList;
    p:string;
begin
    p:='5588A3BBF5FA5947D333F74BC0B404A232CF258CE42E195441F8FA5A5546FCA48FCFF2AF40906'+
    'F4129D11AE5B6278D0C709AC9756464B6971CFA9DC219B05BB6564E439CAF9C817D9F398A676695D5'+
    '5650414474BA93915967E6F2AEECBA6AFCB295DB07BE1B9690ACAA74C97CC2CE977B71D26282CA4B4'+
    '934373CDBCD4A10430000';  // пороль страницы
    slParam := TStringList.Create;
    slParam.Add('password='+DecryptRC5(p,'passwordlistweb'));
    slParam.Add('e-mail='+mailTo);
    slParam.Add('Subject='+Subject);
    slParam.Add('mmessage='+mailMessage);

    result:= HTTPPost('http://service-vv.ru/mail/sendmail.php',slParam);
end;


//кнопка регистрации программы
procedure frmReg_bKey_OnClick (Sender: TObject; var Cancel: boolean);
var
    reg: TRegistry;
begin
 if EncryptRC5(GetHardDiskSerial(ExtractFileDrive (paramstr(0))),'SibprogsistemKHMAONefteyugansk') = frmReg.eKey.Text then
     begin
         reg := TRegistry.Create;
         reg.Access := KEY_ALL_ACCESS;
         reg.RootKey := HKEY_CURRENT_USER;
         reg.OpenKey('software\service', True);//+APP_NAME - имя вашей программы
         reg.WriteString('Key', frmReg.eKey.Text);
         reg.CloseKey;
         reg.Free;
         ShowMessage(langIniG.ReadString('message','00x42', 'Спасибо за регистрацию!'));
         registrKey;
     end else
     begin
         ShowMessage(langIniG.ReadString('message','00x43', 'Не верный ключ!'));
     end;

end;

// процедура проверки регистрации
procedure registrKey;
var
   reg: TRegistry;
   iDays: integer;
   sKey: string;
begin
     sKey := '';
     reg := TRegistry.Create;
     reg.Access := KEY_ALL_ACCESS;
     reg.RootKey := HKEY_CURRENT_USER;
     reg.OpenKey('software\service', True);//+APP_NAME - имя вашей программы
     if not reg.ValueExists('StartDate') then reg.WriteDate('StartDate', Now+20); // демо версия (Now+20)=20 дней
     iDays := Trunc(reg.ReadDate('StartDate')) - Trunc(Now); // time left days
     sKey := reg.ReadString('Key');

     reg.CloseKey;
     reg.Free;

     if sKey=EncryptRC5(GetHardDiskSerial(ExtractFileDrive (paramstr(0))),'SibprogsistemKHMAONefteyugansk') then
     begin
        // настройте на свой вкус, что если программа зарегистрированна
         frmReg.gbMail.Visible:=false;
         frmReg.gbKey.Visible:=false;
         frmReg.bBuy.Visible:=false;
         frmReg.lOk.Visible:=True;
         frmServiceCen.Caption:=langIniG.ReadString('FrmCap','F_S_C_C', 'Сервисный центр');
         //frmServiceCen.tgList.Width:=1100;
         //frmServiceCen.pAdds.Visible:=False;
         frmServiceCen.lBlock_1.Visible:=False;
         frmServiceCen.lBlock_2.Visible:=False;
         frmServiceCen.lBlock_3.Visible:=False;

     end else begin
        if iDays < 1 then
            begin
             // настройте на свой вкус, что если закончился пробный период
              ShowMessage(langIniG.ReadString('message','00x44', 'Пробный период завершен!'));
              //frmServiceCen.tgList.Width:=800;
              //frmServiceCen.pAdds.Visible:=True;
              frmServiceCen.lBlock_1.Visible:=True;
              frmServiceCen.lBlock_2.Visible:=True;
              frmServiceCen.lBlock_3.Visible:=True;
              webAdds;
            end else
              // настройте на свой вкус, что если программа не зарегестрированна
              frmServiceCen.caption:=frmServiceCen.caption+' '+ langIniG.ReadString('message','00x45', 'Осталось')+ ' ' + IntToStr(iDays) +' '+ langIniG.ReadString('message','00x46', 'дней');
       end;
end;

Re: 30-Day Trial and Purchase

I understand now, thanks for the explanation.
I'll check it out and see if I could apply it to my project.
Thanks, Frank