[Скрипт] Защита проекта от несанкционированного использования.

var
   Timer: TTimer;
   iSeconds: integer;
   sUser: string = '';   sBlock: string = '';  sShellExecute: string = '';
   idUser: integer;


procedure frmMain_OnShow (Sender: string; Action: string);
    begin
        frmMain.LabelUser.Caption:=sUser; // запись логина в LabelUser на форме frmMain
////////  Создание резервной копии БД при запуске  ////////////////
        CopyFile('sqlite.db', 'Backup/backup '+ FormatDateTime('dd-mm-yyyy', now)+'.db');
        Timer := TTimer.Create (frmMain);
        Timer.Interval := 1000;
        Timer.Enabled := True;
        Timer.OnTimer := @OnTimer;
    end;


procedure OnTimer (Sender: TObject);
////////  Создание резервной копии БД через 3 часа работы //////////
    begin
        iSeconds := iSeconds + 1;
        if iSeconds > 10800 then
         begin
          iSeconds := 0;
          CopyFile('sqlite.db', 'Backup/backup '+ FormatDateTime('dd-mm-yyyy', now)+'.db'); // запись резервного файла БД каждые 3 часа (10800 секунд)
         end;

        iSeconds := iSeconds + 1;
        if iSeconds > 60 then  // Время в секундах до отключения программы
/////// Предупреждение о демоверсии, очистка гридов и таблиц, выход из программы ////  !!!!!!!!!!
         begin
          iSeconds := 0;
          ShowMessage('ВНИМАНИЕ! ВЫ ПОЛЬЗУЕТЕСЬ ДЕМОНСТРАЦИОННОЙ ВЕРСИЕЙ ПРОГРАММЫ!' + #13#10+ '' + #13#10+ 'СЕЙЧАС ПРОГРАММА БУДЕТ ЗАКРЫТА.' + #13#10+ 'ВСЕ ЗАПИСИ БУДУТ УДАЛЕНЫ.');
// Выбрать это            frmMain.TableGrid1.ClearRows; // очистка грида без удаления данных
// или это           SQLExecute ('DELETE FROM main'); // полное удаление данных из таблицы
            ShowMessage('ДЛЯ ПРОДОЛЖЕНИЯ ОЗНАКОМЛЕНИЯ С ПРОГРАММОЙ ВОЙДИТЕ В НЕЁ ЗАНОВО!');
            frmMain.Close; // закрытие программы
            frmLogin.Close; // закрытие программы
         end;
    end;

procedure frmMain_OnClose (Sender: string; Action: string);
////////  Создание резервной копии БД при выходе и закрытие программы ////////////////
    begin
        CopyFile('sqlite.db', 'Backup/backup '+ FormatDateTime('dd-mm-yyyy', now)+'.db');  // запись резервного файла БД при выходе
        Timer.Free;
        frmLogin.Close;
    end;

procedure frmLogin_chbShowPassword_OnClick (Sender: string);
////////////  Показать/скрыть пароль  ///////////////////
    begin
        if frmLogin.chbShowPassword.Checked then frmLogin.edPassword.PasswordChar := #0
        else frmLogin.edPassword.PasswordChar := '*';
    end;

procedure frmLogin_cbLogin_OnChange (Sender: string);
///////  Копировать из комбобокса в текстбокс  //////
    begin
        frmLogin.edPassword.Text := frmLogin.cbLogin.Text;
    end;

procedure frmLogin_btnOK_OnClick (Sender: string; var Cancel: boolean);
///////////////  Логин, пароль, права пользователей  /////////////////////
    var
       s: string;
    begin
     // SQL запрос логина и пароля пользователя
          s := VarToStr( SQLExecute('SELECT count(id) FROM users WHERE (login = ''' + frmLogin.cbLogin.Text + ''') AND (password = ''' + frmLogin.edPassword.Text + ''');') );
          idUser := SQLExecute('SELECT id FROM users WHERE (login = ''' + frmLogin.cbLogin.Text + ''');');

     // если логин и пароль найдены
         if (s <> '0') then
        begin
          sUser := frmLogin.cbLogin.Text; // запоминание имени пользователя

     // проверка прав администратора
          s := VarToStr( SQLExecute('SELECT administrator FROM users WHERE (login = ''' + sUser + ''');') );

     // если пользователь обладает правами администратора,
          if s='1' then
          frmLogin.btnUsers.Visible := True; // показываем кнопку

     // если пользователь не обладает правами администратора,
          if s='0' then
          frmMain.Button1.Enabled := False; // скрываем кнопку

     // установка прав для Гостя
          s := VarToStr( SQLExecute('SELECT write FROM users WHERE (login = ''' + sUser + ''');') );
          if s='0' then
          begin
          frmMain.Button2.Enabled := False; // скрываем кнопку
          frmMain.Button3.Enabled := False; // скрываем кнопку
          frmMain.Button4.Enabled := False; // скрываем кнопку
          frmMain.Button5.Enabled := False; // скрываем кнопку
          end;

          frmLogin.edPassword.Clear; // очистка пароля
          frmLogin.btnEntry.Enabled := True; // показываем кнопку

         end else MessageDlg('Неверный пароль.' + #13#10+ 'Доступ запрещён.', mtError, mbOk, 0); // сообщение, если пароль неверный
    end;

procedure frmLogin_OnShow (Sender: string; Action: string);
/////////////////// При запуске проекта  //////////////////
var
/////// Ограничение по времени использования программы (TRIAL). Прописывается в реестр ////////
   reg: TRegistry;
   iDays: integer;
begin
     reg := TRegistry.Create;
     reg.Access := KEY_ALL_ACCESS;
     reg.RootKey := HKEY_CURRENT_USER;
     reg.OpenKey('software\ProtectionDemoVersion',true);
     if not reg.ValueExists('StartDate') then reg.WriteDate('StartDate', Now+30); // триал период 30 дней

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

     reg.CloseKey;
     reg.Free;

     if iDays < 1 then
     begin
          if MessageDlg('Пробный период закончился.'+#13+'Вы хотите посетить страницу заказа?', mtInformation, mbYes+mbNo, 0) = mrYes
              then OpenUrl('http://drive-software.com/myvisualdatabase_ru.html#video');

          frmMain.Close;
          frmLogin.Close;
          Exit;
     end;

     if MessageDlg('Демонстрационная версия. Осталось: ' + IntToStr(iDays) +' дней.'+#13+'Вы хотите посетить страницу заказа?', mtInformation, mbYes+mbNo, 0) = mrYes
         then OpenUrl('http://drive-software.com/myvisualdatabase_ru.html#video');

 ////////////// Прочие действия при запуске проекта ////////////////////////////////
       begin
        frmLogin.btnOK.Default:= True;
        frmLogin.btnEntry.Enabled := False; // скрываем кнопку
        frmLogin.LabelUser.Caption:=GetUserName; // Запись в компонент
        frmLogin.btnUsers.Visible := False; // скрываем кнопку
       end;
end;




procedure frmLogin_btnEntry_OnClick (Sender: string; var Cancel: boolean);
////// Проверка GetUserName. Если не записан в таблице Users, то вход запрещён ////
    begin
      if SQLExecute('SELECT Count(*) FROM users WHERE UserName LIKE ''' + GetUserName + '''') = 0 then
        begin
             MessageDlg(('ВАМ ОТКАЗАНО В ДОСТУПЕ' + #13#10+ 'Это рабочее место отсутствует в списке разрешений'),mtError, mbOK, 0);
             frmLogin.Close;
             frmMain.Close;
        end;

        begin
         frmLogin.Hide; // закрытие формы
        end;
    end;

begin
     // Первоначальная проверка, является ли пользователь администратором базы данных
     // если нет, то создается пользователь с логином и паролем администратора 'admin'
     if VarToStr( SQLExecute('SELECT count(id) FROM users WHERE administrator=1;') ) = '0' then
     begin
         SQLExecute('INSERT INTO users (login, password, read, write, remove, search, administrator) VALUES ("admin", "admin", 1, 1, 1, 1, 1);');
         frmLogin.edPassword.Text := 'admin';
     end;

     // Скрываем пароль
     frmLogin.edPassword.PasswordChar := '*';
end.