Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

RFpro.ru: программирование на Delphi и Lazarus


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Boriss
Статус: Академик
Рейтинг: 1149
∙ повысить рейтинг »
Jimhucksly
Статус: 5-й класс
Рейтинг: 760
∙ повысить рейтинг »
Тимошенко Дмитрий
Статус: Студент
Рейтинг: 487
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Delphi и Lazarus

Номер выпуска:1464
Дата выхода:19.11.2009, 18:00
Администратор рассылки:Калашников О.А., Руководитель
Подписчиков / экспертов:579 / 213
Вопросов / ответов:1 / 1

Вопрос № 174223: Здравствуйте! Имеется исходник «БД: Расписание учебных занятий»: Ссылка. Нужно сделать чтобы все данные о группах записывались не в файлы с расширением .db, а в Access'овские файлы....



Вопрос № 174223:

Здравствуйте! Имеется исходник «БД: Расписание учебных занятий»: Ссылка. Нужно сделать чтобы все данные о группах записывались не в файлы с расширением .db, а в Access'овские файлы.

Отправлен: 14.11.2009, 17:43
Вопрос задал: Судейкин Андрей Владимирович, Посетитель
Всего ответов: 1
Страница вопроса »


Отвечает Евгений/Genia007/, Бакалавр :
Здравствуйте, Судейкин Андрей Владимирович.
Вот что из Вашей программы получилось. База сделана в access 2002, пароль на базу lekchii. Изменённый код главного модуля:
Код:
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;
Bev el3: 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);
pro cedure 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 + ' 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;

end.

Изменённый код модуля ввода пароля, пароль 00000:
Код:
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 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;

end.
Прикрепленный файл: загрузить »

-----
Помогли тебе, помоги и ты.

Ответ отправил: Евгений/Genia007/, Бакалавр
Ответ отправлен: 15.11.2009, 09:19

Оценка ответа: 5
Комментарий к оценке:
Превосходно!!!

Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 256527 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:
  • Вам помогли? Пожалуйста, поблагодарите эксперта за это!


    Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)

    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.


    © 2001-2009, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2009.6.11 от 17.11.2009

    В избранное