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;
My Visual Database → General → 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;
// процедура проверки регистрации
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;
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
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
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
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;
I understand now, thanks for the explanation.
I'll check it out and see if I could apply it to my project.
Thanks, Frank
My Visual Database → General → 30-Day Trial and Purchase
Powered by PunBB, supported by Informer Technologies, Inc.
Theme Hydrogen by Kushi