• From: Новосибирск
  • Registered: 2019-11-03
  • Posts: 75

Topic: Trial and Serial Закрытие окна по истечению периода

Доброго дня Коллеги, прошу помощи, на основе приложенного проекта, если программа открыта, то по истечению пробного периода программа будет активна пока ее не закроешь,  помогите модернизировать скрипт чтоб по истечению периода программа не только не давала запускаться но и закрылась ели она работает

Post's attachments

Attachment icon Trial and Serial.zip 5.87 kb, 189 downloads since 2021-05-05 

С уважением.
  • From: Нефтеюганск
  • Registered: 2018-04-11
  • Posts: 1,775

Re: Trial and Serial Закрытие окна по истечению периода

Patriot10200 wrote:

Доброго дня Коллеги, прошу помощи, на основе приложенного проекта, если программа открыта, то по истечению пробного периода программа будет активна пока ее не закроешь,  помогите модернизировать скрипт чтоб по истечению периода программа не только не давала запускаться но и закрылась ели она работает

if iDays < 1 then
     begin
          if IDOK = MessageBox('Trial period is over.', 'Trial period is over', MB_OK+MB_ICONERROR) then Form1.Close;
     end;

3 Reply by Patriot10200 (edited by Patriot10200 2021-05-05 10:19:07)

  • From: Новосибирск
  • Registered: 2019-11-03
  • Posts: 75

Re: Trial and Serial Закрытие окна по истечению периода

sibprogsistem wrote:
Patriot10200 wrote:

Доброго дня Коллеги, прошу помощи, на основе приложенного проекта, если программа открыта, то по истечению пробного периода программа будет активна пока ее не закроешь,  помогите модернизировать скрипт чтоб по истечению периода программа не только не давала запускаться но и закрылась ели она работает

if iDays < 1 then
     begin
          if IDOK = MessageBox('Trial period is over.', 'Trial period is over', MB_OK+MB_ICONERROR) then Form1.Close;
     end;

Изменяю дату на компьютере, но программа к сожалению не закрывается, м.б. я не правильно выразился, мне нужно чтобы убивался процесс работы программы по истечению триала.

if iDays < 1 then
     begin
          frmNagScreen.lbTrial.Caption := 'Период ознакомительного режима закончился,';
          if IDOK = MessageBox('Trial period is over.', 'Trial period is over', MB_OK+MB_ICONERROR) then glavnaya.close;
          Exit;
     end;
С уважением.
  • Registered: 2014-08-02
  • Posts: 914

Re: Trial and Serial Закрытие окна по истечению периода

Hello Patriot10200

You could use this snippet :

procedure Form1_OnShow (Sender: string; Action: string);
var
   reg: TRegistry;
   iDays: integer;
begin
     reg := TRegistry.Create;
     reg.Access := KEY_ALL_ACCESS;
     reg.RootKey := HKEY_CURRENT_USER;
     reg.OpenKey('software\MyVisualDatabaseTrial',true);
     if not reg.ValueExists('StartDate') then reg.WriteDate('StartDate', Now+30); // trial period is 30 days

     iDays := Trunc(reg.ReadDate('StartDate')) - Trunc(Now); // time left days

     reg.CloseKey;
     reg.Free;

     if iDays < 1 then
     begin
          if MessageDlg('Trial period is over.'+#13+' Do you want to visit a order page?', mtInformation, mbYes+mbNo, 0) = mrYes
              then OpenUrl('http://yourpage.com');

          Form1.Close;
          Exit;
     end;

     if MessageDlg('Demo version. Time left: ' + IntToStr(iDays) +' days.'+#13+'Do you want to visit a order page?', mtInformation, mbYes+mbNo, 0) = mrYes
         then OpenUrl('http://yourpage.com');

end;

begin
end.

JB

5 Reply by Patriot10200 (edited by Patriot10200 2021-05-06 10:24:27)

  • From: Новосибирск
  • Registered: 2019-11-03
  • Posts: 75

Re: Trial and Serial Закрытие окна по истечению периода

Всем спасибо, помогла процедура на кнопку.

rocedure reestr_putevih_listov_Button1_OnClick (Sender: TObject; var Cancel: boolean);

   var
   reg: TRegistry;
   iDays: integer;
   sKey: string;
begin
     sKey := '';
     reg := TRegistry.Create;
     reg.Access := KEY_ALL_ACCESS;
     reg.RootKey := HKEY_CURRENT_USER;
     reg.OpenKey('System',true);
     if not reg.ValueExists('StartDate') then reg.WriteDate('StartDate', Now+30); // trial period is 30 days

     iDays := Trunc(reg.ReadDate('StartDate')) - Trunc(Now); // time left days
     sKey := reg.ReadString('Key');

     reg.CloseKey;
     reg.Free;

     if sKey<>'' then
     begin
         if CheckKey(sKey) then Exit;
     end;

     if iDays < 1 then
     begin
 if MessageDlg('Ознакомительный период закончился.'+#13+'Программа заблокирована'+#13+'Связаться с разработчиком?', mtInformation, mbYes+mbNo, 0) = mrYes
              then frmAbout.ShowModal;
 if MessageDlg('Зарегестрировать программу?', mtInformation, mbYes+mbNo, 0) = mrYes
              then frmNagScreen.ShowModal;
          reestr_putevih_listov.Button6.Enabled := False;
          reestr_putevih_listov.Button8.Enabled := False;
          reestr_putevih_listov.Button3.Enabled := False;
          reestr_putevih_listov.Button9.Enabled := False;
          reestr_putevih_listov.Button5.Enabled := False;
          reestr_putevih_listov.Panel1.Visible := False;
          reestr_putevih_listov.TableGrid1.Enabled := False;
          new_putevoy.Button1.Enabled := False;
          new_putevoy.Button2.Enabled := False;
          new_putevoy.Button3.Enabled := False;
          new_putevoy.close_putevoi.Enabled := False;
          glavnaya.Button1.Visible := False;
          glavnaya.Button5.Visible := False;
          glavnaya.Button2.Visible := False;
          glavnaya.Button3.Visible := False;
          glavnaya.Button4.Visible := False;
          glavnaya.Button7.Visible := False;
          glavnaya.Button6.Visible := False;
          glavnaya.Button15.Visible := False;
          glavnaya.Button12.Visible := False;
          glavnaya.Button8.Visible := False;
          glavnaya.Button10.Visible := False;
          glavnaya.Button11.Visible := False;
          glavnaya.Button9.Visible := False;
          glavnaya.Button14.Visible := False;
          glavnaya.Label1.Caption := 'Программа заблокирована, свяжитесь с разработчиком!!!';
          glavnaya.Label1.Visible := True;
    end;
end;

ТЕМА ЗАКРЫТА

С уважением.