Вопрос № 174223: Здравствуйте! Имеется исходник «БД: Расписание учебных занятий»: Ссылка. Нужно сделать чтобы все данные о группах записывались не в файлы с расширением .db, а в Access'овские файлы....
Вопрос № 174223:
Здравствуйте! Имеется исходник «БД: Расписание учебных занятий»: Ссылка. Нужно сделать чтобы все данные о группах записывались не в файлы с расширением .db, а в Access'овские файлы.
Отвечает Евгений/Genia007/, Бакалавр :
Здравствуйте, Судейкин Андрей Владимирович. Вот что из Вашей программы получилось. База сделана в access 2002, пароль на базу lekchii. Изменённый код главного модуля:
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 + ' Or
der by WeekDay'); // Добавить новый запрос 3: Form1.ADOQuery1.SQL.Add('Select * from' + s + ' Order by DisTime
39;); // Добавить новый запрос 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 := 'Группа ' + Com
boBox3.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.T
extOut(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; <
br>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
39;..'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 t
hen 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.OpenDial
og1Close(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 + ']' +
39;(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;
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 Act
ion: 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); beg
in 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;
* Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи.
(полный список тарифов)
** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
*** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.