Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Содержание сайт... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Создание отчето... 64931
Модуль Forms 64732
Пример работы с... 62916
ТЕХНОЛОГИИ ДОСТ... 61436
Имитационное мо... 57278
Реклама
Сейчас на сайте
Гостей: 4
На сайте нет зарегистрированных пользователей

Пользователей: 13,081
новичок: Abdukarimov A
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Метод конечных разностей для интерполяции/экстраполяции на Delphi
Изменения контуров и сортировка в двумерном массиве чисел на Turbo Pasca...
Калькулятор на Delphi с переводом в другую систему исчисления + Блок схемы

Реклама



Подписывайся на YouTube канал о программировании, что бы не пропустить новые видео!

ПОДПИСЫВАЙСЯ на канал о программировании
Тестирование на Delphi 7
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.



Опубликовал Kest June 17 2013 00:27:53 · 0 Комментариев · 4898 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Нет комментариев.
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Программирование ...
около 291 статьи ...
45 уроков по дельфи
Заставка. Изображ...
Иллюстрированный ...
Delphi 6/7 базы д...
Синтаксический ан...
3D Тетрис [Исходн...
DelphiXIsoDemo1
Калькулятор [Исхо...
Sztransppanel
Swing. Эффектные...
PDJPack
Прграммирование в...
Assembler. Практикум
Программирование ...
База Allsubmitter...
JanButtonsV
Изучаем Ассемблер
CS:Source - монит...

Топ загрузок
Приложение Клие... 100461
Delphi 7 Enterp... 86550
Converter AMR<-... 20075
GPSS World Stud... 12608
Borland C++Buil... 11733
Borland Delphi ... 8550
Turbo Pascal fo... 7036
Visual Studio 2... 4997
Калькулятор [Ис... 4756
FreeSMS v1.3.1 3540
Случайные статьи
PHP против ASP - д...
Найти среднее ариф...
6.4. Задачи
Доставка групповог...
Хорошие советы для...
Создатели Windows ...
Простой графически...
Компоненты триггера
Г-слоя в физике пл...
Указатель "идентиф...
Команды факс-модема
Вирусный трафик
Баннерная реклама ...
Эффективное уменьш...
Использование прог...
Основная работа ок...
Заказ презентации
Подбор плитки в кухню
Глава 5
Стеки на связанных...
ФАНТОМНЫЕ ФАЙЛЫ
Продолжительность ...
Поиск потерявшихся...
14.2. Две важные ф...
Перенос WSUS из Se...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?