Unit1:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, Unit3, Grids, ComCtrls;
type
TSubject = record //структура описывающая тему
Name : String[254]; //наименование
Sz : Integer; //размер
end;
TTesting = record //структура результатов тестов
num, res1, res2, res_t: Integer; //номер теста, результат до и результат после изучения темы, индех верного результата
Name : String[254]; //наименование темы
Login : String[32]; //логин пользователя
Date1, Date2 : String[20]; //дата и время начала и окончания изучения темы
end;
TTest = record //структура тестов
Prnt : String[254]; //наименования темы
Sz : Integer; //размер
Key : Longint; //уникальный идентификатор теста
_Var : array[0 .. 3] of String[254]; //варианты ответа на тест
end;
TTheme = class (TObject) //класс для работы со структурами
constructor Create; overload;
public
Subject : TSubject;
Test : TTest;
Body : TStringList; //массив с текстом темы или тестов
User : TUser;
end;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
StringGrid1: TStringGrid;
N6: TMenuItem;
N7: TMenuItem;
ListBox1: TListBox;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Edit1: TEdit;
RichEdit1: TRichEdit;
BitBtn4: TBitBtn;
Panel2: TPanel;
ListBox2: TListBox;
RichEdit2: TRichEdit;
StringGrid2: TStringGrid;
Panel3: TPanel;
RichEdit3: TRichEdit;
RadioGroup1: TRadioGroup;
Panel4: TPanel;
Panel5: TPanel;
StringGrid3: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure RichEdit1Change(Sender: TObject);
procedure RichEdit2Change(Sender: TObject);
procedure StringGrid2SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure Panel4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
procedure Panel4Click(Sender: TObject);
procedure Panel5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel5Click(Sender: TObject);
private
{ Private declarations }
procedure OnListUsers();
procedure OnSaveTheme();
procedure OnThemeList();
procedure OnDeleteTheme(name : String);
function GetKey() : Longint;
function GetTestName() : String;
procedure OnSaveTest();
procedure OnTestList(prnt : String; test: boolean);
procedure OnDeleteTest(prnt : String; key : Longint);
function OnTest(start : boolean) : boolean;
procedure OnSaveResult();
procedure OnResultList(login: String);
public
User : TUser;
TstList : TStringList;
{ Public declarations }
end;
var
Form1: TForm1;
Modified, TestModified : boolean; //флаги изменения текста темы и теста
Testing : TTesting;
implementation
uses
Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject); //инициализация главной формы
begin
Form1.Enabled := False;
StringGrid1.Cells[0,0] := 'Учетная запись';
StringGrid1.Cells[1,0] := 'Логин';
StringGrid1.Cells[2,0] := 'Пароль';
StringGrid1.Cells[3,0] := 'Имя';
StringGrid1.Cells[4,0] := 'Фамилия';
StringGrid1.Cells[5,0] := 'Группа';
StringGrid2.Cells[0,0] := '№ ответа';
StringGrid2.Cells[0,1] := '1';
StringGrid2.Cells[0,2] := '2';
StringGrid2.Cells[0,3] := '3';
StringGrid2.Cells[0,4] := '4';
StringGrid2.Cells[1,0] := 'Варианты ответа(вариант №1 верный по умолчанию)';
StringGrid3.Cells[0,0] := 'Тема';
StringGrid3.Cells[1,0] := 'Начало';
StringGrid3.Cells[2,0] := 'Результат до';
StringGrid3.Cells[3,0] := 'Результат после';
StringGrid3.Cells[4,0] := 'Окончание';
StringGrid1.DefaultColWidth := StringGrid1.ClientWidth div StringGrid1.ColCount;
StringGrid3.ColWidths[0] := StringGrid1.ClientWidth - StringGrid3.DefaultColWidth * 4;
Modified := False;
TestModified := False;
end;
procedure TForm1.N2Click(Sender: TObject); //смена пользователя
begin
if User.admin = False then
TstList.Free;
Panel5.Visible := False;
N7.Enabled := True;
N5.Enabled := True;
StringGrid1.Visible := False;
StringGrid2.Visible := False;
StringGrid3.Visible := False;
Panel1.Visible := False;
Panel2.Visible := False;
Panel3.Visible := False;
ListBox1.Visible := False;
RichEdit1.Visible := False;
RichEdit2.Visible := False;
Application.CreateForm(TForm2, Form2);
Form1.Enabled := False;
end;
procedure TForm1.N3Click(Sender: TObject); //завершение работы
begin
Close;
end;
procedure TForm1.N5Click(Sender: TObject); //переход к режиму "Список пользователей"
begin
if Panel3.Visible = True then
Exit;
N5.Enabled := False;
N7.Enabled := True;
Panel2.Visible := False;
Panel1.Visible := False;
RichEdit1.Visible := False;
RichEdit2.Visible := False;
StringGrid2.Visible := False;
ListBox1.Visible := False;
StringGrid1.RowCount := 2;
Panel5.Caption := 'Посмотреть результаты тестов';
if User.admin = False then
begin
StringGrid1.Cells[0,1] := 'Студент';
StringGrid1.Cells[1,1] := User.Login;
StringGrid1.Cells[2,1] := User.Pass;
StringGrid1.Cells[3,1] := User.Name;
StringGrid1.Cells[4,1] := User.SurName;
StringGrid1.Cells[5,1] := User.Group;
end
else
begin
Panel5.Visible := True;
OnListUsers;
end;
StringGrid1.Visible := True;
end;
procedure TForm1.OnListUsers(); //заполнение списка пользователей
var fl : TFileStream;
usrs : TUser;
i, len, sz : Integer;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('list.tst') then
begin
fl := TFileStream.Create('list.tst', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
if i > 1 then
StringGrid1.RowCount := StringGrid1.RowCount + 1;
fl.Read(sz, 4);
fl.Read(usrs, sz);
StringGrid1.Cells[0,i] := 'Студент';
if usrs.admin = True then
StringGrid1.Cells[0,i] := 'Администратор';
StringGrid1.Cells[1,i] := Decrypt(usrs.Login, 128);
StringGrid1.Cells[2,i] := Decrypt(usrs.Pass, 128);
StringGrid1.Cells[3,i] := Decrypt(usrs.Name, 128);
StringGrid1.Cells[4,i] := Decrypt(usrs.SurName, 128);
StringGrid1.Cells[5,i] := Decrypt(usrs.Group, 128);
end;
fl.Free;
end;
end;
procedure TForm1.N7Click(Sender: TObject); //переход в режим "Темы"
begin
N7.Enabled := False;
N5.Enabled := True;
BitBtn1.Caption := 'Открыть';
BitBtn2.Caption := 'Удалить';
BitBtn4.Caption := 'Тесты';
StringGrid1.Visible := False;
StringGrid3.Visible := False;
ListBox1.Items.Clear;
RichEdit1.Visible := False;
OnThemeList();
ListBox1.ItemIndex := 0;
ListBox1Click(nil);
if User.admin = False then
begin
BitBtn2.Visible := False;
BitBtn3.Visible := False;
BitBtn4.Visible := False;
Edit1.Enabled := False;
Edit1.Left := BitBtn2.Left;
Edit1.Width := Panel1.ClientWidth - BitBtn1.Width - 20;
end
else
begin
BitBtn2.Visible := True;
BitBtn3.Visible := True;
BitBtn4.Visible := True;
Edit1.Enabled := True;
Edit1.Left := BitBtn4.Left + BitBtn4.Width;
Edit1.Width := Panel1.ClientWidth - BitBtn1.Width * 4 - 20;
end;
Panel1.Visible := True;
Panel5.Visible := False;
ListBox1.Visible := True;
end;
procedure TForm1.BitBtn3Click(Sender: TObject); //добавление тем или тестов
var i: Integer;
ok : boolean;
Theme : TTheme;
begin
if ((RichEdit2.Visible = False) and (Panel2.Visible = True)) or ((RichEdit1.Visible = False) and (Panel2.Visible = False)) or ( (RichEdit1.Visible = False) and (RichEdit2.Visible = False) ) then
begin
if Panel2.Visible = False then
begin
ok := False;
if Length(Edit1.Text) = 0 then
begin
ShowMessage('Укажите название темы!');
ok := True;
end;
for i := 0 to ListBox1.Items.Count-1 do
begin
if ListBox1.Items.Strings[ListBox1.ItemIndex] = Edit1.Text then
begin
ShowMessage('Тема с таким названием уже существует!');
ok := True;
break;
end;
end;
if ok = False then
begin
ListBox1.Items.Add(Edit1.Text);
RichEdit1.Lines.Clear;
ListBox1.SetFocus;
ListBox1.ItemIndex := ListBox1.Items.Count-1;
RichEdit1.Visible := True;
Edit1.Enabled := False;
BitBtn1.Caption := 'Закрыть';
BitBtn2.Caption := 'Сохранить';
RichEdit1.SetFocus;
Modified := True;
end;
end
else
begin
Theme := TTheme.Create;
RichEdit2.Lines.Clear;
ListBox2.Items.AddObject(GetTestName(), Theme);
(TTheme(ListBox2.Items.Objects[ListBox2.Items.Count-1])).Test.Key := GetKey();
ListBox2.ItemIndex := ListBox2.Items.Count-1;
RichEdit2.Visible := True;
StringGrid2.Cells[1,1] := '';
StringGrid2.Cells[1,2] := '';
StringGrid2.Cells[1,3] := '';
StringGrid2.Cells[1,4] := '';
StringGrid2.Visible := True;
BitBtn1.Caption := 'Закрыть';
BitBtn2.Caption := 'Сохранить';
end;
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject); //удаление/сохранение тем или тестов
begin
if Panel2.Visible = True then
begin
if RichEdit2.Visible = True then
begin
if ListBox2.Items.Count <> 0 then
OnDeleteTest(ListBox1.Items.Strings[ListBox1.ItemIndex], (TTheme(ListBox2.Items.Objects[ListBox2.ItemIndex])).Test.Key);
OnSaveTest();
TestModified := False;
end
else
begin
if ListBox2.Items.Count <> 0 then
begin
OnDeleteTest(ListBox1.Items.Strings[ListBox1.ItemIndex], (TTheme(ListBox2.Items.Objects[ListBox2.ItemIndex])).Test.Key);
TestModified := False;
end;
end;
end
else
begin
if RichEdit1.Visible = True then
begin
if ListBox1.Items.Count <> 0 then
OnDeleteTheme(ListBox1.Items.Strings[ListBox1.ItemIndex]);
OnSaveTheme();
Modified := False;
end
else
begin
if ListBox1.Items.Count <> 0 then
begin
OnDeleteTest(ListBox1.Items.Strings[ListBox1.ItemIndex], 0);
OnDeleteTheme(ListBox1.Items.Strings[ListBox1.ItemIndex]);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
if ListBox1.Items.Count <> 0 then
Edit1.Text := ListBox1.Items.Strings[ListBox1.ItemIndex];
end;
procedure TForm1.BitBtn1Click(Sender: TObject); //просмотр/редактирование или закрытие тем или тестов
var i : Integer;
begin
if BitBtn1.Caption = 'Закрыть' then
begin
if Panel2.Visible = True then
begin
if TestModified = True then
begin
if MessageBox(Handle, 'Сохранить изменения?', 'Произошли изменения', MB_YESNO or MB_ICONQUESTION) = IDYES then
BitBtn2Click(nil);
end;
if RichEdit2.Visible = True then
begin
BitBtn1.Caption := 'Открыть';
RichEdit1.Visible := False;
BitBtn2.Caption := 'Удалить';
RichEdit2.Visible := False;
StringGrid2.Visible := False;
end;
end
else
begin
if (Modified = True) and (User.admin = true ) then
begin
if MessageBox(Handle, 'Сохранить изменения?', 'Произошли изменения', MB_YESNO or MB_ICONQUESTION) = IDYES then
BitBtn2Click(nil);
end;
BitBtn1.Caption := 'Открыть';
RichEdit1.Visible := False;
if OnTest(False) = True then
begin
Panel3.Visible := True;
Panel1.Visible := False;
end;
if User.admin = True then
begin
Edit1.Enabled := True;
BitBtn2.Caption := 'Удалить';
end;
end;
end
else
begin
if Panel2.Visible = True then
begin
if ListBox2.Items.Count <> 0 then
begin
RichEdit2.Lines.Clear;
for i:=1 to StringGrid2.RowCount-1 do
StringGrid2.Cells[1,i] := (TTheme(ListBox2.Items.Objects[ListBox2.ItemIndex])).Test._Var[i-1];
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
(TTheme(ListBox2.Items.Objects[ListBox2.ItemIndex])).Body.SaveToFile('rich.tmp');
RichEdit2.Lines.LoadFromFile('rich.tmp');
Modified := False;
DeleteFile('rich.tmp');
BitBtn1.Caption := 'Закрыть';
BitBtn2.Caption := 'Сохранить';
RichEdit2.Visible := True;
StringGrid2.Visible := True;
TestModified := False;
end;
end
else
begin
if ListBox1.Items.Count <> 0 then
begin
if OnTest(True) = True then
begin
Panel3.Visible := True;
Panel1.Visible := False;
end;
RichEdit1.Lines.Clear;
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
(TTheme(ListBox1.Items.Objects[ListBox1.ItemIndex])).Body.SaveToFile('rich.tmp');
RichEdit1.Lines.LoadFromFile('rich.tmp');
Modified := False;
DeleteFile('rich.tmp');
if User.admin = True then
begin
RichEdit1.Visible := True;
Edit1.Enabled := False;
BitBtn1.Caption := 'Закрыть';
BitBtn2.Caption := 'Сохранить';
RichEdit1.SetFocus;
end
else
begin
RichEdit1.Visible := True;
BitBtn1.Caption := 'Закрыть';
RichEdit1.SetFocus;
end;
end;
end;
end;
end;
procedure TForm1.OnSaveTheme(); //запись тем в файл
var fl, tmp, buf : TFileStream;
sz: Integer;
sub : TSubject;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('theme.tst') then
begin
fl := TFileStream.Create('theme.tst', fmOpenRead);
tmp := TFileStream.Create('theme.tmp', fmCreate);
fl.Read(sz, 4);
sz := sz + 1;
tmp.Write(sz, 4);
tmp.CopyFrom(fl, fl.Size - 4);
fl.Free;
end
else
begin
tmp := TFileStream.Create('theme.tst', fmCreate);
sz := 1;
tmp.Write(sz, 4);
end;
sub.Name := ListBox1.Items.Strings[ListBox1.ItemIndex];
RichEdit1.Lines.SaveToFile('rich.tmp');
buf := TFileStream.Create('rich.tmp', fmOpenRead);
sub.Sz := buf.Size;
sz := sizeof(sub);
tmp.Write(sz, 4);
tmp.Write(sub, sz);
tmp.CopyFrom(buf, buf.Size);
tmp.Free;
buf.Free;
DeleteFile('rich.tmp');
if FileExists('theme.tmp') then
begin
CopyFile('theme.tmp', 'theme.tst', False);
DeleteFile('theme.tmp');
end;
end;
procedure TForm1.OnThemeList(); //чтение тем из файла
var fl, buf: TFileStream;
i, sz, len : Integer;
sub : TSubject;
Theme : TTheme;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('theme.tst') then
begin
fl := TFileStream.Create('theme.tst', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(sub, sz);
buf := TFileStream.Create('rich.tmp', fmCreate);
buf.CopyFrom(fl, sub.Sz);
buf.Free;
Theme := TTheme.Create;
ListBox1.Items.AddObject(sub.Name, Theme);
(TTheme(ListBox1.Items.Objects[ListBox1.Items.Count-1])).Subject := sub;
(TTheme(ListBox1.Items.Objects[ListBox1.Items.Count-1])).Body.LoadFromFile('rich.tmp');
DeleteFile('rich.tmp');
end;
fl.Free;
end;
end;
constructor TTheme.Create; //конструктор класса для работы со структурами
begin
Body := TStringList.Create;
end;
procedure TForm1.OnDeleteTheme(name : String);//удаление из файла тем
var fl, buf: TFileStream;
i, sz, len, b : Integer;
sub : TSubject;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('theme.tst') then
begin
fl := TFileStream.Create('theme.tst', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(sub, sz);
if sub.Name = ListBox1.Items.Strings[ListBox1.ItemIndex] then
begin
sz := fl.Position - sz - 4;
fl.Position := 0;
fl.Seek(4, soFromBeginning);
buf := TFileStream.Create('theme.tmp', fmCreate);
b := len - 1;
buf.Write(b, 4);
buf.CopyFrom(fl, sz);
fl.Seek(4 + sizeof(sub) + sub.Sz, soFromCurrent);
buf.CopyFrom(fl, fl.Size - fl.Position);
buf.Free;
break;
end
else
begin
fl.Seek(sub.Sz, soFromCurrent);
end;
end;
fl.Free;
if FileExists('theme.tmp') then
begin
CopyFile('theme.tmp', 'theme.tst', False);
DeleteFile('theme.tmp');
end;
end;
end;
procedure TForm1.BitBtn4Click(Sender: TObject); //переход к списку тестов/обратно к темам
begin
if BitBtn4.Caption = 'Тесты' then
begin
if ListBox1.Items.Count <> 0 then
begin
if (RichEdit1.Visible = True )and (Modified = True ) then
begin
if MessageBox(Handle, 'Сохранить изменения?', 'Произошли изменения', MB_YESNO or MB_ICONQUESTION) = IDYES then
BitBtn2Click(nil);
end;
ListBox2.Items.Clear;
BitBtn4.Caption := 'Темы';
OnTestList(ListBox1.Items.Strings[ListBox1.ItemIndex], False);
ListBox2.ItemIndex := 0;
Panel2.Visible := True;
Edit1.Enabled := False;
if RichEdit1.Visible = True then
begin
BitBtn1.Caption := 'Открыть';
BitBtn2.Caption := 'Удалить';
end;
end;
end
else
begin
ListBox1Click(nil);
BitBtn4.Caption := 'Тесты';
RichEdit2.Visible := False;
StringGrid2.Visible := False;
Panel2.Visible := False;
Edit1.Enabled := True;
if RichEdit1.Visible = False then
begin
BitBtn1.Caption := 'Открыть';
BitBtn2.Caption := 'Удалить';
end
else
begin
BitBtn1.Caption := 'Закрыть';
BitBtn2.Caption := 'Сохранить';
end;
end;
end;
procedure TForm1.RichEdit1Change(Sender: TObject); //выставляем флаг о том, что текст темы был изменен
begin
Modified := True;
end;
function TForm1.GetKey() : Longint; //генеоация уникального идентификатора тестов
var key, tmp : Longint;
getst : TSystemTime;
begin
GetLocalTime(getst);
key := GetTickCount();
tmp := Longint(getst.wDay) * Longint(24) * Longint(3600);
key := key + tmp;
tmp := Longint(getst.wMonth) * Longint(30) * Longint(24) * Longint(3600);
key := key + tmp;
Result := key;
end;
function TForm1.GetTestName() : String; //генерация номера теста
var i, j : Integer;
str : String;
ok : boolean;
begin
j := 1;
ok := False;
repeat
str := 'Тест №' + IntToStr(j);
for i := 0 to ListBox2.Items.Count-1 do
begin
if ListBox2.Items.Strings[i] <> ('Тест №' + IntToStr(j)) then
begin
ok := True;
break;
end;
j := j + 1;
end;
if (ok = True) or ( ListBox2.Items.Count = 0 ) then
break;
until false;
Result := str;
end;
procedure TForm1.RichEdit2Change(Sender: TObject); //выставляем флаг о том, что текст теста был изменен
begin
TestModified := True;
end;
procedure TForm1.OnSaveTest(); //записываем тест в файл
var fl, tmp, buf : TFileStream;
sz, i: Integer;
sub : TTest;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('tests.tst') then
begin
fl := TFileStream.Create('tests.tst', fmOpenRead);
tmp := TFileStream.Create('tests.tmp', fmCreate);
fl.Read(sz, 4);
sz := sz + 1;
tmp.Write(sz, 4);
tmp.CopyFrom(fl, fl.Size - 4);
fl.Free;
end
else
begin
tmp := TFileStream.Create('tests.tst', fmCreate);
sz := 1;
tmp.Write(sz, 4);
end;
sub.Prnt := ListBox1.Items.Strings[ListBox1.ItemIndex];
for i:=1 to StringGrid2.RowCount-1 do
sub._Var[i-1] := StringGrid2.Cells[1,i];
sub.Key := (TTheme(ListBox2.Items.Objects[ListBox2.ItemIndex])).Test.Key;
RichEdit2.Lines.SaveToFile('rich.tmp');
buf := TFileStream.Create('rich.tmp', fmOpenRead);
sub.Sz := buf.Size;
sz := sizeof(sub);
tmp.Write(sz, 4);
tmp.Write(sub, sz);
tmp.CopyFrom(buf, buf.Size);
tmp.Free;
buf.Free;
DeleteFile('rich.tmp');
if FileExists('tests.tmp') then
begin
CopyFile('tests.tmp', 'tests.tst', False);
DeleteFile('tests.tmp');
end;
end;
procedure TForm1.StringGrid2SetEditText(Sender: TObject; ACol, //функция ограничения длины строки
ARow: Integer; const Value: String);
begin
if Length(Value) > 254 then
StringGrid2.Cells[ACol,ARow] := StringGrid2.Cells[ACol,ARow];
end;
procedure TForm1.OnTestList(prnt: String; test: boolean); //считываем список тестов
var fl, buf: TFileStream;
i, sz, len : Integer;
sub : TTest;
Theme : TTheme;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('tests.tst') then
begin
fl := TFileStream.Create('tests.tst', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(sub, sz);
if sub.Prnt = prnt then
begin
buf := TFileStream.Create('rich.tmp', fmCreate);
buf.CopyFrom(fl, sub.Sz);
buf.Free;
Theme := TTheme.Create;
if test = False then
begin
ListBox2.Items.AddObject(GetTestName(), Theme);
(TTheme(ListBox2.Items.Objects[ListBox2.Items.Count-1])).Test := sub;
(TTheme(ListBox2.Items.Objects[ListBox2.Items.Count-1])).Body.LoadFromFile('rich.tmp');
end
else
begin
TstList.AddObject(GetTestName(), Theme);
(TTheme(TstList.Objects[TstList.Count-1])).Test := sub;
(TTheme(TstList.Objects[TstList.Count-1])).Body.LoadFromFile('rich.tmp');
end;
DeleteFile('rich.tmp');
end
else
begin
fl.Seek(sub.Sz, soFromCurrent);
end;
end;
fl.Free;
end;
end;
procedure TForm1.OnDeleteTest(prnt : String; key : Longint); //удаляем тест из файла
var fl, buf: TFileStream;
i, sz, len, b : Integer;
sub : TTest;
k : Longint;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('tests.tst') then
begin
k := key;
fl := TFileStream.Create('tests.tst', fmOpenRead);
buf := TFileStream.Create('tests.tmp', fmCreate);
fl.Read(len, 4);
b := len;
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(sub, sz);
if key = 0 then
k := sub.Key;
if ( sub.prnt <> prnt ) and ( sub.Key <> k ) then
begin
fl.Seek(fl.Position - sz - 4, soFromCurrent);
buf.CopyFrom(fl, sz + 4 + sub.Sz);
b := b - 1;
end
else
begin
fl.Seek(sub.Sz, soFromCurrent);
end;
end;
fl.Free;
if buf.Size <> 0 then
begin
buf.Free;
DeleteFile('tests.tst');
fl := TFileStream.Create('tests.tst', fmCreate);
buf := TFileStream.Create('tests.tmp', fmOpenRead);
fl.Write(b, 4);
fl.CopyFrom(buf, buf.Size);
fl.Free;
buf.Free;
DeleteFile('tests.tmp');
end
else
begin
buf.Free;
end;
end;
end;
function TForm1.OnTest(start : boolean) : boolean; //подготовка теста
var tmp, i : Integer;
ok : boolean;
begin
Result := False;
if User.admin = False then
begin
Testing.Name := '';
if start = True then
Testing.res1 := 1;
TstList.Clear;
OnTestList(ListBox1.Items.Strings[ListBox1.ItemIndex], True);
if TstList.Count <> 0 then
begin
RadioGroup1.Items.Clear;
Result := True;
Testing.Name := ListBox1.Items.Strings[ListBox1.ItemIndex];
Testing.Login := User.Login;
RichEdit3.Lines.Clear;
randomize;
Testing.num := random(TstList.Count);
Testing.res_t := -1;
tmp := random(4);
if tmp = 0 then
Testing.res_t := 0;
RadioGroup1.Items.Add((TTheme(TstList.Objects[Testing.num])).Test._Var[tmp]);
repeat
tmp := random(4);
ok := True;
for i:=0 to RadioGroup1.Items.Count-1 do
begin
if (TTheme(TstList.Objects[Testing.num])).Test._Var[tmp] = RadioGroup1.Items.Strings[i] then
begin
ok := False;
break;
end;
end;
if ok = True then
begin
RadioGroup1.Items.Add((TTheme(TstList.Objects[Testing.num])).Test._Var[tmp]);
if tmp = 0 then
Testing.res_t := RadioGroup1.Items.Count-1;
end;
if RadioGroup1.Items.Count = 4 then
break;
until False;
RadioGroup1.ItemIndex := 0;
RichEdit3.Lines.Clear;
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
(TTheme(TstList.Objects[Testing.num])).Body.SaveToFile('rich.tmp');
RichEdit3.Lines.LoadFromFile('rich.tmp');
DeleteFile('rich.tmp');
end;
end;
end;
procedure TForm1.Panel4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Panel4.BevelOuter := bvLowered;
end;
procedure TForm1.Panel4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Panel4.BevelOuter := bvRaised;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if User.admin = False then
TstList.Free;
end;
procedure TForm1.Panel4Click(Sender: TObject); //прохождение теста
begin
if Testing.res1 = 1 then
begin
Testing.res1 := -1;
if RadioGroup1.ItemIndex = Testing.res_t then
Testing.res1 := 0;
Testing.Date1 := DateTimeToStr(Now());
end
else
begin
Testing.res2 := -1;
if RadioGroup1.ItemIndex = Testing.res_t then
Testing.res2 := 0;
Testing.Date2 := DateTimeToStr(Now());
Testing.Login := User.Login;
OnSaveResult();
end;
Panel1.Visible := True;
Panel3.Visible := False;
end;
procedure TForm1.OnSaveResult(); //запись результатов изучения темы
var fl, tmp: TFileStream;
sz: Integer;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('results.tst') then
begin
fl := TFileStream.Create('results.tst', fmOpenRead);
tmp := TFileStream.Create('results.tmp', fmCreate);
fl.Read(sz, 4);
sz := sz + 1;
tmp.Write(sz, 4);
tmp.CopyFrom(fl, fl.Size - 4);
fl.Free;
end
else
begin
tmp := TFileStream.Create('results.tst', fmCreate);
sz := 1;
tmp.Write(sz, 4);
end;
sz := sizeof(Testing);
tmp.Write(sz, 4);
tmp.Write(Testing, sz);
tmp.Free;
if FileExists('results.tmp') then
begin
CopyFile('results.tmp', 'results.tst', False);
DeleteFile('results.tmp');
end;
end;
procedure TForm1.Panel5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Panel5.BevelOuter := bvLowered;
end;
procedure TForm1.Panel5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Panel5.BevelOuter := bvRaised;
end;
procedure TForm1.Panel5Click(Sender: TObject); //просмотр результатов тестов
begin
if Panel5.Caption = 'Посмотреть результаты тестов' then
begin
StringGrid3.Visible := True;
Panel5.Caption := 'Закрыть';
StringGrid3.RowCount := 2;
StringGrid3.Cells[0,1] := '';
StringGrid3.Cells[1,1] := '';
StringGrid3.Cells[2,1] := '';
StringGrid3.Cells[3,1] := '';
StringGrid3.Cells[4,1] := '';
OnResultList(StringGrid1.Cells[1,StringGrid1.Row]);
end
else
begin
StringGrid3.Visible := False;
Panel5.Caption := 'Посмотреть результаты тестов';
end;
end;
procedure TForm1.OnResultList(login: String); //считывание результатов тестов из файла
var fl: TFileStream;
i, sz, len : Integer;
sub : TTesting;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('results.tst') then
begin
fl := TFileStream.Create('results.tst', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(sub, sz);
if login = sub.Login then
begin
if StringGrid3.Cells[0,1] <> '' then
StringGrid3.RowCount := StringGrid3.RowCount + 1;
StringGrid3.Cells[0,StringGrid3.RowCount-1] := sub.Name;
StringGrid3.Cells[1,StringGrid3.RowCount-1] := sub.Date1;
if sub.res1 = 0 then
begin
StringGrid3.Cells[2,StringGrid3.RowCount-1] := 'положительно';
end
else
begin
StringGrid3.Cells[2,StringGrid3.RowCount-1] := 'отрицательно';
end;
if sub.res2 = 0 then
begin
StringGrid3.Cells[3,StringGrid3.RowCount-1] := 'положительно';
end
else
begin
StringGrid3.Cells[3,StringGrid3.RowCount-1] := 'отрицательно';
end;
StringGrid3.Cells[4,StringGrid3.RowCount-1] := sub.Date2;
end;
end;
fl.Free;
end;
end;
end.
Unit2:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Unit1, Unit3;
type
TForm2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
LabeledEdit5: TLabeledEdit;
LabeledEdit6: TLabeledEdit;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
procedure BitBtn2Click(Sender: TObject);
procedure LabeledEdit2KeyPress(Sender: TObject; var Key: Char);
procedure LabeledEdit4KeyPress(Sender: TObject; var Key: Char);
procedure LabeledEdit6KeyPress(Sender: TObject; var Key: Char);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
private
{ Private declarations }
function GetRegIn() : boolean;
procedure SavePass();
function IsLoginExists(login : String) : TUser;
public
{ Public declarations }
end;
var
Form2: TForm2;
const Digit: Set of Char = ['0' .. '9'];
const LetLrg: Set of Char = ['A' .. 'Z'];
const LetLtl: Set of Char = ['a' .. 'z'];
const Let: Set of Char = ['А' .. 'я'];
implementation
{$R *.dfm}
procedure TForm2.BitBtn2Click(Sender: TObject); //переход к регистрации
begin
LabeledEdit3.Visible := True;
LabeledEdit4.Visible := True;
LabeledEdit5.Visible := True;
LabeledEdit6.Visible := True;
BitBtn1.Visible := False;
BitBtn2.Visible := False;
BitBtn4.Visible := False;
BitBtn3.Visible := True;
BitBtn5.Visible := True;
BitBtn6.Visible := True;
Constraints.MaxHeight := BitBtn6.Top + BitBtn6.Height + 40;
Constraints.MaxWidth := BitBtn3.Left + BitBtn3.Width + 20;
Constraints.MinHeight := Constraints.MaxHeight;
Constraints.MinWidth := Constraints.MaxWidth;
Left := Form1.Left + ( Form1.Width - Width ) div 2;
Top := Form1.Top + ( Form1.Height - Height ) div 2;
end;
procedure TForm2.LabeledEdit2KeyPress(Sender: TObject; var Key: Char); //проверка ввода с клавиатуры
begin
if not (Key in Digit) and not (Key in LetLrg) and not (Key in LetLtl) and not (Key = #8) then
Key:=#0;
end;
procedure TForm2.LabeledEdit4KeyPress(Sender: TObject; var Key: Char); //проверка ввода с клавиатуры
begin
if not (Key in Let) and not (Key = #8) then
Key:=#0;
end;
procedure TForm2.LabeledEdit6KeyPress(Sender: TObject; var Key: Char); //проверка ввода с клавиатуры
begin
if not (Key in Digit) and not (Key in Let) and not (Key = #45) and not (Key = #8) then
Key:=#0;
end;
function TForm2.GetRegIn() : boolean; //проверка - корректны ли введенные данные
var i, len : Integer;
str : String;
User : TUser;
begin
Result := True;
Label1.Caption := 'ok';
Label2.Caption := 'ok';
Label3.Caption := 'ok';
Label4.Caption := 'ok';
Label5.Caption := 'ok';
Label6.Caption := 'ok';
Label1.Font.Color := clGreen;
Label2.Font.Color := clGreen;
Label3.Font.Color := clGreen;
Label4.Font.Color := clGreen;
Label5.Font.Color := clGreen;
Label6.Font.Color := clGreen;
str := LabeledEdit1.Text;
len := Length(str);
if len <> 0 then
begin
for i := 1 to len do
begin
if not (str[i] in Digit) and not (str[i] in LetLrg) and not (str[i] in LetLtl) then
begin
Label1.Caption := 'допускаются только символы латинского алфавита и цифры!';
Label1.Font.Color :=clRed;
Result := False;
break;
end;
end;
User := IsLoginExists(str);
if not (User.Pass = '' ) then
begin
Label1.Caption := 'данный логин занят, выберите другой!';
Label1.Font.Color :=clRed;
Result := False;
end;
end
else
begin
Label1.Caption := 'поле должно быть заполнено!';
Label1.Font.Color :=clRed;
Result := False;
end;
str := LabeledEdit2.Text;
len := Length(str);
if len > 5 then
begin
for i := 1 to len do
begin
if not (str[i] in Digit) and not (str[i] in LetLrg) and not (str[i] in LetLtl) then
begin
Result := False;
Label2.Caption := 'допускаются только символы латинского алфавита и цифры!';
Label2.Font.Color :=clRed;
break;
end;
end;
end
else
begin
Result := False;
Label2.Caption := 'должно быть не меньше 6 символов!';
Label2.Font.Color :=clRed;
end;
if not ( LabeledEdit2.Text = LabeledEdit3.Text ) then
begin
Result := False;
Label3.Caption := 'пароль не верен!';
Label3.Font.Color :=clRed;
end;
str := LabeledEdit4.Text;
len := Length(str);
if len = 0 then
begin
Label4.Caption := 'поле должно быть заполнено!';
Label4.Font.Color :=clRed;
Result := False;
end;
str := LabeledEdit5.Text;
len := Length(str);
if len = 0 then
begin
Label5.Caption := 'поле должно быть заполнено!';
Label5.Font.Color :=clRed;
Result := False;
end;
str := LabeledEdit6.Text;
len := Length(str);
if len = 0 then
begin
Label6.Caption := 'поле должно быть заполнено!';
Label6.Font.Color :=clRed;
Result := False;
end;
Label1.Visible := True;
Label2.Visible := True;
Label3.Visible := True;
Label4.Visible := True;
Label5.Visible := True;
Label6.Visible := True;
if ( Length(Label1.Caption) >= Length(Label2.Caption)) and (Length(Label1.Caption) >= Length(Label3.Caption) ) and (Length(Label1.Caption) >= Length(Label4.Caption)) and (Length(Label1.Caption) >= Length(Label5.Caption) ) and (Length(Label1.Caption) >= Length(Label6.Caption) )then
begin
len := Label1.Width;
end
else
begin
if( Length(Label2.Caption) >= Length(Label1.Caption) ) and (Length(Label2.Caption) >= Length(Label3.Caption) ) and (Length(Label2.Caption) >= Length(Label4.Caption) ) and (Length(Label2.Caption) >= Length(Label5.Caption) ) and (Length(Label2.Caption) >= Length(Label6.Caption) ) then
begin
len := Label2.Width;
end
else
if( Length(Label3.Caption) >= Length(Label1.Caption) ) and (Length(Label3.Caption) >= Length(Label2.Caption) ) and (Length(Label3.Caption) >= Length(Label4.Caption) ) and (Length(Label3.Caption) >= Length(Label5.Caption) ) and (Length(Label3.Caption) >= Length(Label6.Caption) ) then
begin
len := Label3.Width;
end
else
if( Length(Label4.Caption) >= Length(Label1.Caption) ) and (Length(Label4.Caption) >= Length(Label2.Caption) ) and (Length(Label4.Caption) >= Length(Label3.Caption) ) and (Length(Label4.Caption) >= Length(Label5.Caption) ) and (Length(Label4.Caption) >= Length(Label6.Caption) ) then
begin
len := Label4.Width;
end
else
if( Length(Label5.Caption) >= Length(Label1.Caption) ) and (Length(Label5.Caption) >= Length(Label2.Caption) ) and (Length(Label5.Caption) >= Length(Label3.Caption) ) and (Length(Label5.Caption) >= Length(Label4.Caption) ) and (Length(Label5.Caption) >= Length(Label6.Caption) ) then
begin
len := Label5.Width;
end
else
begin
len := Label6.Width;
end
end;
Constraints.MaxHeight := BitBtn6.Top + BitBtn6.Height + 40;
Constraints.MaxWidth := BitBtn3.Left + BitBtn3.Width + 30 + len;
Constraints.MinHeight := Constraints.MaxHeight;
Constraints.MinWidth := Constraints.MaxWidth;
Left := Form1.Left + ( Form1.Width - Width ) div 2;
Top := Form1.Top + ( Form1.Height - Height ) div 2;
end;
procedure TForm2.BitBtn3Click(Sender: TObject); //регистрация аккаунта
begin
if GetRegIn() = True then
begin
SavePass();
BitBtn3.Visible := False;
end;
end;
procedure TForm2.SavePass(); //сохранение данных пользователя
var fl, tmp : TFileStream;
sz : Integer;
User : TUser;
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('list.tst') then
begin
fl := TFileStream.Create('list.tst', fmOpenRead);
tmp := TFileStream.Create('list.tmp', fmCreate);
fl.Read(sz, 4);
sz := sz + 1;
tmp.Write(sz, 4);
tmp.CopyFrom(fl, fl.Size - 4);
fl.Free;
User.admin := False;
end
else
begin
tmp := TFileStream.Create('list.tst', fmCreate);
sz := 1;
tmp.Write(sz, 4);
User.admin := True;
end;
User.Login := Encrypt(LabeledEdit1.Text, 128);
User.Pass := Encrypt(LabeledEdit2.Text, 128);
User.Name := Encrypt(LabeledEdit4.Text, 128);
User.SurName := Encrypt(LabeledEdit5.Text, 128);
User.Group := Encrypt(LabeledEdit6.Text, 128);
sz := sizeof(User);
tmp.Write(sz, 4);
tmp.Write(User, sz);
tmp.Free;
if FileExists('list.tmp') then
begin
CopyFile('list.tmp', 'list.tst', False);
DeleteFile('list.tmp');
end;
end;
procedure TForm2.BitBtn1Click(Sender: TObject);//вход в программу пользователя
var User : TUser;
begin
User := IsLoginExists(LabeledEdit1.Text);
if not( LabeledEdit2.Text = '' ) and (LabeledEdit2.Text = User.Pass ) then
begin
Form1.Enabled:= True;
Form1.Caption := User.Login + '(' + User.Name + ' ' + User.SurName + ': ' + User.Group + ')';
if User.admin = True then
begin
Form1.Caption := Form1.Caption + ' Администратор';
end
else
begin
Form1.Caption := Form1.Caption + ' Студент';
end;
if User.admin = False then
Form1.TstList := TStringList.Create;
Form1.User := User;
Form2.Close;
end
else
begin
ShowMessage('Неверный логин или пароль');
end;
end;
procedure TForm2.FormCreate(Sender: TObject); // инициализация формы входа/регистрации
begin
Constraints.MaxHeight := LabeledEdit2.Top + LabeledEdit2.Height + 40;
Constraints.MaxWidth := BitBtn4.Left + BitBtn4.Width + 20;
Constraints.MinHeight := Constraints.MaxHeight;
Constraints.MinWidth := Constraints.MaxWidth;
Left := Form1.Left + ( Form1.Width - Width ) div 2;
Top := Form1.Top + ( Form1.Height - Height ) div 2;
end;
procedure TForm2.BitBtn4Click(Sender: TObject); //завершение работы
begin
Form1.Close;
end;
procedure TForm2.BitBtn5Click(Sender: TObject); //переход в режим входа в программу
begin
LabeledEdit3.Visible := False;
LabeledEdit4.Visible := False;
LabeledEdit5.Visible := False;
LabeledEdit6.Visible := False;
BitBtn1.Visible := True;
BitBtn2.Visible := True;
BitBtn4.Visible := True;
BitBtn3.Visible := False;
BitBtn5.Visible := False;
BitBtn6.Visible := False;
Label1.Visible := False;
Label2.Visible := False;
Label3.Visible := False;
Label4.Visible := False;
Label5.Visible := False;
Label6.Visible := False;
Constraints.MaxHeight := LabeledEdit2.Top + LabeledEdit2.Height + 40;
Constraints.MaxWidth := BitBtn4.Left + BitBtn4.Width + 20;
Constraints.MinHeight := Constraints.MaxHeight;
Constraints.MinWidth := Constraints.MaxWidth;
Left := Form1.Left + ( Form1.Width - Width ) div 2;
Top := Form1.Top + ( Form1.Height - Height ) div 2;
end;
function TForm2.IsLoginExists(login : String) : TUser;//проверка на уникальность логина
var fl : TFileStream;
sz, len, i : Integer;
str : String;
User : TUser;
begin
Result := User;
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('list.tst') then
begin
fl := TFileStream.Create('list.tst', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(User, sz);
str := Decrypt(User.Login, 128);
if login = str then
begin
User.Login := Decrypt(User.Login, 128);
User.Pass := Decrypt(User.Pass, 128);
User.Name := Decrypt(User.Name, 128);
User.SurName := Decrypt(User.SurName, 128);
User.Group := Decrypt(User.Group, 128);
Result := User;
break;
end;
end;
fl.Free;
end;
end;
end.
Unit3:
unit Unit3;
interface
type
TUser = record // данные пользователя
Login : String[32]; // логин
Pass : String[32]; // пароль
Name : String[32]; // имя
SurName : String[32];// фамилия
Group : String[32]; // группа
admin : boolean; // тип учетной записи
end;
function Encrypt(const str : String; key : byte) : String; // функция шифрования
function Decrypt(const cryptstr : String; key : byte) : String; // функция расшифровки
implementation
function Encrypt(const str : String; key : byte) : String; //шифруем сроку
var i : Integer;
tmp, cryptstr : String;
begin
for i:=1 to Length(str) do
begin
tmp := chr(ord(str[i]) xor key);
cryptstr := cryptstr + tmp;
end;
Result := cryptstr;
end;
function Decrypt(const cryptstr : String; key : byte) : String; //расшифруем сроку
var i : Integer;
tmp, decryptstr : String;
begin
for i:=1 to Length(cryptstr) do
begin
tmp := chr(ord(cryptstr[i]) xor key);
decryptstr := decryptstr + tmp;
end;
Result := decryptstr;
end;
end.
|
Главная
Каталог файлов
