unit sql;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Variants, DB, ImgList, Menus, ExtCtrls, Grids, DBGrids,
  printers, ADODB;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ComboBox2: TComboBox;
    Label3: TLabel;
    Bevel1: TBevel;
    Button2: TButton;
    RadioGroup1: TRadioGroup;
    CheckBox2: TCheckBox;
    Button3: TButton;
    Button4: TButton;
    Button6: TButton;
    Button7: TButton;
    Bevel3: TBevel;
    Edit3: TEdit;
    MainMenu1: TMainMenu;
    N1: TMenuItem;        
    N2: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    ImageList1: TImageList;
    N7: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ComboBox3: TComboBox;
    Bevel2: TBevel;
    N4: TMenuItem;
    N6: TMenuItem;
    N9: TMenuItem;
    Button1: TButton;
    ADOQuery1: TADOQuery;
    OpenDialog1: TOpenDialog;
    ADOConnection1: TADOConnection;
    ADOQuery1NameDis: TWideStringField;
    ADOQuery1Prepod: TWideStringField;
    ADOQuery1WeekDay: TWideStringField;
    ADOQuery1DisTime: TDateTimeField;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3Change(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure DataSource1UpdateData(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure OpenDialog1Close(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  a: Byte;

implementation
 Uses About, PasDlg;

{$R *.DFM}

procedure Zapros(s: string);  //  Процедура выбора записей из базы
begin
  If Form1.Combobox3.Text = '' then  //  Если в комбобоксе выбрана группа вызываем запрос
    exit;
  s:= '[' + s + ']';  // Обрамление строки скобками
  Form1.ADOQuery1.Close;  //   Закрыть запрос
  Form1.ADOQuery1.SQL.Clear;  //  Стереть запрос
  Case Form1.ComboBox2.ItemIndex of  //  Выбираем индекс выбранной строчки в комбобоксе
    0: Form1.ADOQuery1.SQL.Add('Select * from' + s + ' Order by NameDis');  //   Добавить новый запрос
    1: Form1.ADOQuery1.SQL.Add('Select * from' + s + ' Order by Prepod');  //   Добавить новый запрос
    2: Form1.ADOQuery1.SQL.Add('Select * from' + s + ' Order by WeekDay');  //   Добавить новый запрос
    3: Form1.ADOQuery1.SQL.Add('Select * from' + s + ' Order by DisTime');  //   Добавить новый запрос
  else
    Form1.ADOQuery1.SQL.Add('Select * from' + s + ' Order by NameDis');  //   Добавить новый запрос
  end;
  Form1.ADOQuery1.Open;  //   Открыть запрос
end;

procedure TForm1.FormCreate(Sender: TObject);  //  Действия при создании формы
begin
  Application.Title:='База данных лекций текущего семестра';  //  Установить название программы в панеле задач
  a:= 0;
  //  Подключение базы
  ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='
    +ExtractFilePath(ParamStr(0))+'Data\Lekchii.mdb;Persist Security Info=True;'+
    'Jet OLEDB:Database Password=lekchii;'; // Добавление параметров базы
  //
  Try
    ADOConnection1.Connected:=true; // Подключение баз
  Except
    MessageDlg('Похоже база не найдена',mtWarning,[mbOK],0);
    OpenDialog1.Execute; // Вывод диалога выбора базы
  end;
  //
  // нахождение всех таблиц в базе данных
  ADOConnection1.GetTableNames(ComboBox3.Items, false);
  If ComboBox3.Items.Count > 0 then
    begin
      Combobox3.ItemIndex:= 0;  //  Выбрали первую группу из списка
      Zapros(Combobox3.Text);  //  Вызов процедуры запроса
    end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Application.CreateForm(TPassDlg, PassDlg);  //  Создали форму пароля
  PassDlg.ShowModal;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var
   P, I, J, YPos, XPos, HorzSize, VertSize: Integer;
   AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize, FontHeight: Integer;
   mmx, mmy: Extended;
begin
  //  Установка размеров
  HeaderSize := 100;
  FooterSize := 200;
  ZeilenSize := 36;
  FontHeight := 36;
  //  Инициализация принтера
  Printer.Orientation := poPortrait {poLandscape};
  Printer.Title  := 'Группа ' + ComboBox3.Text;
  Printer.BeginDoc;
  //  Масштабирование
  mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
     GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
  mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
     GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;
  VertSize := Trunc(mmy) * 10;
  HorzSize := Trunc(mmx) * 10;
  SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);
  //  Центр
  Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize;
  //  Размещение сетки
  if ADOQuery1.RecordCount mod Zeilen <> 0 then
     AnzSeiten := ADOQuery1.RecordCount div Zeilen + 1
   else
     AnzSeiten := ADOQuery1.RecordCount div Zeilen;
  Seite := 1;
  //  Рисование линий
  for P := 1 to AnzSeiten do
   begin
    Printer.Canvas.Font.Height := 48;
    Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth('Группа ' + ComboBox3.Text) div 2)),
       - 20, 'Группа ' + ComboBox3.Text);
    Printer.Canvas.Font.Height := FontHeight;
    YPos := HeaderSize + 20;
    XPos := 3;
    //  Печать шапки таблицы
    Printer.Canvas.TextOut(XPos, - YPos, 'Наименование дисциплины');
    XPos := XPos + DBGrid1.Columns[0].Width * 3;
    Printer.Canvas.TextOut(XPos, - YPos, 'Преподаватель');
    XPos := XPos + DBGrid1.Columns[1].Width * 3;
    Printer.Canvas.TextOut(XPos, - YPos, 'День недели');
    XPos := XPos + DBGrid1.Columns[2].Width * 3;
    Printer.Canvas.TextOut(XPos, - YPos, 'Время');
    XPos := XPos + DBGrid1.Columns[3].Width * 3;
    Printer.Canvas.Pen.Width := 1;
    Printer.Canvas.MoveTo(0, - YPos);
    Printer.Canvas.LineTo(XPos,  - YPos);
    YPos := YPos + FontHeight;
    ADOQuery1.First;
    //  Печать таблицы
    for I := 1 to Zeilen do
      begin
        if ADOQuery1.RecordCount >= I + (Seite - 1) * Zeilen then
          begin
            XPos := 3;
            for J := 0 to 3 do
              begin
                Printer.Canvas.TextOut(XPos, - YPos, DBGrid1.Fields[j].Value);
                XPos := XPos + DBGrid1.Columns[j].Width * 3;
                Printer.Canvas.MoveTo(0, - YPos);
                Printer.Canvas.LineTo(XPos,  - YPos);
              end;
            YPos := YPos + ZeilenSize;
            ADOQuery1.Next;
          end;
      end;
    Printer.Canvas.MoveTo(0, - YPos);
    Printer.Canvas.LineTo(XPos,  - YPos);
    XPos := 0;
    Printer.Canvas.MoveTo(XPos, - (HeaderSize + 20));
    Printer.Canvas.LineTo(XPos,  - YPos);
    For j:= 0 to 3 do
      begin
        XPos := XPos + DBGrid1.Columns[j].Width * 3;
        Printer.Canvas.MoveTo(XPos, - (HeaderSize + 20));
        Printer.Canvas.LineTo(XPos,  - YPos);
      end;
    Inc(Seite);
    if Seite <= AnzSeiten then Printer.NewPage;
  end;
  Printer.EndDoc;
end;

procedure TForm1.Button2Click(Sender: TObject);  //   Нажатие кнопки 2
begin
  If a <> 0 then
    begin
      ADOQuery1.Post;  //   Сохранить базу
      a:= 0;
    end;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);  //   клик по чекбоксу2
begin
  if CheckBox2.Checked = true then  //   Если стоит флажок сделать
    begin
      CheckBox2.Caption:= 'Режим поиска включен';  //   Присвоить название чекбоксу2
      Edit3.SetFocus;  //   Фокус на поле ввода3
    end
  else
    CheckBox2.Caption:= 'Режим поиска выключен';  //   иначе присвоить другое название чекбоксу2
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ADOQuery1.First;  //   Переход на первую запись в запросе
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ADOQuery1.Last;  //   Переход на последнюю запись в запросе
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  ADOQuery1.Last;
  ADOQuery1.Insert;  //   вставить новую запись в базу
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  If MessageDlg('Вы действительно хотите удалить запись?', mtWarning, [mbOK, mbNO], 0) = mrOK then
    ADOQuery1.Delete;  //   Удалить текущую запись из базы
end;

procedure TForm1.ComboBox2KeyPress(Sender: TObject; var Key: Char);  //   Нажатие клавиш в комбобоксе2
begin
  if Key = #13 then
    begin
      Key:= #0;
      Zapros(Combobox3.Text);
    end;
end;

procedure TForm1.DataSource1UpdateData(Sender: TObject);  //   при обновлении данных в базе
begin
  a:= 0;
end;

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);  //   Нажатие клавиш в сетке
var
  s: string;
begin
  a:= 1;
  if DBGrid1.SelectedField.FieldName <> 'DisTime' then  //  Если текущее поле не равно DisTime
    case key of  //  Разрешаем вводить буквы, точку, enter, backspace, пробел
      'a'..'z' : ;
      'A'..'Z' : ;
      'а'..'я' : ;
      'А'..'Я' : ;
      '.' : ;
      #13 : ;
      #8 : ;
      #32 : ;
    else
      begin
        key:= #0;  //  Все отстальные символы не отображаем и выводим предупреждение
        If DBGrid1.SelectedField.FieldName = 'NameDis' then
          s:= 'Наименование дисциплины'
        else
          If DBGrid1.SelectedField.FieldName = 'Prepod' then
            s:= 'Преподаватель'
          else
            If DBGrid1.SelectedField.FieldName = 'WeekDay' then
              s:= 'День недели';
        ShowMessage('Поле ''' + s + ''' не может состоять из символов или чисел');
      end;
    end;
end;

procedure TForm1.Edit3Change(Sender: TObject);  //   Изменения данных в поле ввода3
var
  strField:string;
begin
  if not CheckBox2.Checked then Exit;  //   Если не стоит флажок в чекбоксе2 выйти из процедуры
  // выбрать поле поиска
  case RadioGroup1.ItemIndex of
    0: strField:='NameDis';
    1: strField:='Prepod';
    2: strField:='WeekDay';
  end;
  If Combobox3.Text <> '' then  //  Если в Combobox3.Text выбрана группа делаем поиск
    begin
      // выполнить поиск
      ADOQuery1.Close;
      ADOQuery1.SQL.Clear;
      //  ' LIKE "%'+Edit3.Text+'%"' - ищет фрагмент текста
      ADOQuery1.SQL.Add('Select * from ['+ComboBox3.Text+']'+' where '+strField+' like '''+Edit3.Text+'%''');
      ADOQuery1.Open;
    end;
end;

procedure TForm1.N7Click(Sender: TObject);  //   Нажатие седьмой кнопки в главном меню
begin
  close;  //   закрыть программу
end;

procedure TForm1.N8Click(Sender: TObject);  //   Нажатие восьмой кнопки в главном меню
begin
   AboutBox.ShowModal;  //   Показать форму о программе в модальном режиме
end;

procedure TForm1.OpenDialog1Close(Sender: TObject);
begin
  //  Подключение базы
  ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='
    +OpenDialog1.FileName+';Persist Security Info=True;'+
    'Jet OLEDB:Database Password=lekchii;'; // Добавление параметров базы
  Try
    ADOConnection1.Connected:=true; // Подключение баз
  Except
    MessageDlg('Похоже база не найдена',mtWarning,[mbOK],0);
    OpenDialog1.Execute; // Вывод диалога выбора базы
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.Terminate;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);  //   Перед закрытием программы выполнить
begin
  If a = 1 then  //   Если а равно 1 показать окно сообщения с кнопками ДА, НЕТ, ОТМЕНИТЬ с иконкой вопроса
    case messageBox(Handle,'Сохранить изменения в БД перед выходом?','Выход',
      mb_YesNoCancel or mb_iconquestion) of
      mrYes: ADOQuery1.Post;  //   Если нажали кнопку ДА сохранить базу
      mrNo:CanClose:= true;  //  Если нажали кнопку НЕТ выйти из программы без сохранения базы
      mrCancel:CanClose:= false;  //  Если нажали ОТМЕНА не выходить из программы
    end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);  //  Создание новой таблицы
var
  TabName1: string;
begin
  TabName1:= InputBox('База данных лекций текущего семестра', 'Введите название группы', '');  //  Вводим название группы
  if TabName1 = '' then
    begin
      MessageDlg('Название группы не может быть пустой', mtError, [mbOk], 0);  //  Если не ввели название выходим из процедуры
      exit;
    end;
  //  ДОбавление таблицы
  try
    ADOQuery1.SQL.Clear;
    ADOQuery1.SQL.Add('CREATE TABLE ' + '[' + TabName1 + ']' + '(NameDis Text(50), Prepod Text(20), WeekDay Text(15), ' +
              'DisTime Time, id Counter, PRIMARY KEY (id))');
    ADOQuery1.Parameters.Clear;
    ADOQuery1.Prepared:= true;
      // ExecSQL, а не Open. Иначе ... облом
    ADOQuery1.ExecSQL;
    Showmessage('Таблица ' + TabName1 + ' успешно создана');
    except
      // Обработка ошибок открытия таблицы Возможности обработчика можно расширить.
      Exception.Create('Ошибка создания таблицы');
    end;
  //
  ComboBox3.Items.Add(TabName1);  //  Добавить группу в список
  ComboBox3.Text:= TabName1;
  ComboBox2.ItemIndex:= 0;
  Zapros(TabName1);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);  //  Удалить таблицу
var
  TabName1: string;
  i: integer;
begin
  TabName1:= InputBox('База данных лекций текущего семестра', 'Введите название группы для удаления', '');  //  Вводим название группы
  if TabName1 = '' then
    begin
      MessageDlg('Название группы не может быть пустой', mtError, [mbOk], 0);  //  Если не ввели название выходим из процедуры
      exit;
    end;
   //  Удаление таблицы
   try
     ADOQuery1.SQL.Clear;
     ADOQuery1.SQL.Add('DROP TABLE ' + '[' + TabName1 + ']');
     ADOQuery1.Parameters.Clear;
     ADOQuery1.Prepared:= true;
     // ExecSQL, а не Open. Иначе ... облом
     ADOQuery1.ExecSQL;
     Showmessage('Таблица ' + TabName1 + ' успешно удалена.');
   except
     // Обработка ошибок открытия таблицы Возможности обработчика можно расширить.
     Exception.Create('Ошибка удаления таблицы');
   end;
   //
   for i:= 0 to Combobox3.Items.Count - 1 do  //  Удаляем группу из списка
    If Combobox3.Items.Strings[i] = TabName1 then
      Combobox3.Items.Delete(i);
   Combobox3.Text:= ComboBox3.Items.Strings[0];
   ComboBox2.ItemIndex:= 0;
   Zapros(Combobox3.Text);
end;

procedure TForm1.ComboBox3Change(Sender: TObject);  //  Выбор группы
begin
  Zapros(Combobox3.Text);
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  Zapros(Combobox3.Text);
end;

end.

unit PasDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, ExtCtrls;

type
  TPassDlg = class(TForm)
    Button1: TButton;
    Button2: TButton;
    MaskEdit1: TMaskEdit;
    RadioGroup1: TRadioGroup;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MaskEdit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  PassDlg: TPassDlg;

implementation

uses sql;

{$R *.dfm}

function Pass(ss, pas: String): boolean;  //  Функция шифровки пароля
var
  i: integer;
  s: String[255];
  c: array[0..255] of Byte absolute s;
begin
  s:= ss;
  for i := 1 to Ord(s[0]) do
    c[i] := 23 xor c[i];
  result := s = pas;
end;

procedure TPassDlg.Button1Click(Sender: TObject);
begin
  Button1.Tag:= 1;
  PassDlg.Close;  //  Закрыть форму ввода пароля
end;

procedure TPassDlg.Button2Click(Sender: TObject);
begin
  Application.Terminate;  //  Выход из программы
end;

procedure TPassDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;  //  Освободили память занимаемуб формой
end;

procedure TPassDlg.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  If Button1.Tag = 1 then
    begin
      if RadioGroup1.ItemIndex = 0 then
        Form1.Caption:= 'База данных: Расписание учебных занятий для пользователя'
      else
        begin
          if Pass(MaskEdit1.Text, '''''''''''') then  //  Вызов функции шифровки пароля
            begin
              Form1.Button2.Enabled:= true;  //  Разрешение кнопок
              Form1.Button6.Enabled:= true;
              Form1.Button7.Enabled:= true;
              Form1.BitBtn1.Enabled:= true;
              Form1.BitBtn2.Enabled:= true;
              Form1.N2.Enabled:= true;
              Form1.N6.Enabled:= true;
              Form1.N9.Enabled:= true;
              Form1.N14.Enabled:= true;
              Form1.N15.Enabled:= true;
              Form1.DBGrid1.ReadOnly:= false;
              Form1.Caption:= 'База данных: Расписание учебных занятий для администратора'
            end
          else
            begin
              ShowMessage('Неверный пароль. форма откроется с правами пользователя.');
              Form1.Caption:= 'База данных: Расписание учебных занятий для пользователя'
            end;
        end;
    end
  else
    Application.Terminate;
end;

procedure TPassDlg.MaskEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then  //  Если нажата enter выполняем
    Button1.Click;
end;

procedure TPassDlg.RadioGroup1Click(Sender: TObject);
begin
  If RadioGroup1.ItemIndex = 1 then  //  Разрешение поля ввода пароля
    begin
      MaskEdit1.Enabled:= true;
      MaskEdit1.SetFocus;
    end
  else
    MaskEdit1.Enabled:= false
end;

end.