Навигация
Главная
Поиск
Форум
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
21 ошибка прогр... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Имитационное мо... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Реклама
Сейчас на сайте
Гостей: 12
На сайте нет зарегистрированных пользователей

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

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

Тестирование на 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 16 2013 20:27:53 · 0 Комментариев · 6309 Прочтений · Для печати

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


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



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

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

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

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

Пароль



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

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

Случайные загрузки
AlnComponents
Программирование ...
Пример работы с ф...
ProLIB18
Proeffectimage
Анекдоты с ostrie.ru
Добавление к ссы...
Rss Parser
FormShape [Исходн...
Illusion
PHP/MySQL для нач...
Использование Lis...
API (Применение A...
ZipForge
ИНТЕРНЕТ ПРОГРАММ...
MicroGPSS Studen ...
C++ Стандартная б...
Delphi 2005 Секре...
NetGraph [Исходни...
Как программирова...

Топ загрузок
Приложение Клие... 100793
Delphi 7 Enterp... 98016
Converter AMR<-... 20298
GPSS World Stud... 17059
Borland C++Buil... 14238
Borland Delphi ... 10373
Turbo Pascal fo... 7390
Калькулятор [Ис... 6080
Visual Studio 2... 5228
Microsoft SQL S... 3674
Случайные статьи
Вывод результатов ...
Денежные слоты
Программное обеспе...
Стереовыход для At...
Способы и схемы по...
3.5. РЕШЕНИЕ: ИСПО...
на попытки сканиро...
Внешние ссылки, об...
Служба удаленного ...
Настройка размера ...
Добавление свободн...
Какие возможности ...
Отрисовка связных ...
Косвенная адресация
Экспертные системы...
Проблема универсал...
Разберем детали. П...
Пример программиро...
Окно Add Table пос...
Радиостанции
autocad lt
Блок TRANSPER
Функция GetModeNam...
при их аутет-ифиющий
Игровой автомат Bo...
Статистика



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


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