Разработка программы для оценки через систему тестирования знаний

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

// --- Уменьшить время на ответ на 1 секунду ---

Lbl_Last.Caption:=DecTime(PrTimeLast,Sender);

end;

procedure TForm1.MIOpenFileClick(Sender: TObject);

begin

FormCreate(Sender);

OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName);

if OpenDialog1.Execute then

Memo_Temp.Lines.LoadFromFile(OpenDialog1.FileName);

end;

procedure TForm1.MIAboutClick(Sender: TObject);

begin

ShowMessage('Разработчик: Хаитов И;'+#13+#10+

' '+#13+#10+

'Благодарности'+#13+#10+

' '+#13+#10+

'* за разработку блока шифрования и интерфейса:'+#13+#10+

' Ikrom;'+#13+#10+

' '+#13+#10+

'* за помощь в разработке:'+#13+#10+

' }{ak,'+#13+#10+

' '+#13+#10+

'http://www.vkontakte.ru/khaitov'+#13+#10+

'e-mail: ikrom1989_80@mail.ru');

end;

// Заполение полей теста

procedure TForm1.PrFillFileds(Sender: TObject);

begin

// Очистка поля теста

MQuestion.Clear;

MV1.Clear;

MV2.Clear;

MV3.Clear;

MV4.Clear;

MQuestion.Lines[0]:=decrypt(Memo_Temp.Lines[2+6*(PrOrderQuestion[NomQuestion]-1)], 30000);

MV1.Lines[0]:=decrypt(Memo_Temp.Lines[3+6*(PrOrderQuestion[NomQuestion]-1)], 30000);

MV2.Lines[0]:=decrypt(Memo_Temp.Lines[4+6*(PrOrderQuestion[NomQuestion]-1)], 30000);

MV3.Lines[0]:=decrypt(Memo_Temp.Lines[5+6*(PrOrderQuestion[NomQuestion]-1)], 30000);

MV4.Lines[0]:=decrypt(Memo_Temp.Lines[6+6*(PrOrderQuestion[NomQuestion]-1)], 30000);

Lbl_NomQuestion.Caption:=decrypt(IntToStr(NomQuestion), 30000);

// Управление полосой прокрутки в полях теста

if MQuestion.Lines.Count>=3 then MQuestion.scrollbars:=ssVertical else MQuestion.scrollbars:=ssNone;

if MV1.Lines.Count>=3 then MV1.scrollbars:=ssVertical else MV1.scrollbars:=ssNone;

if MV2.Lines.Count>=3 then MV2.scrollbars:=ssVertical else MV2.scrollbars:=ssNone;

if MV3.Lines.Count>=3 then MV3.scrollbars:=ssVertical else MV3.scrollbars:=ssNone;

if MV4.Lines.Count>=3 then MV4.scrollbars:=ssVertical else MV4.scrollbars:=ssNone;

end;

// Пункт из меню "Начать тестирование"

procedure TForm1.MITBeginClick(Sender: TObject);

Var

tempNomQuestion, i, j: byte;

begin

// Проверка был ли открыт файл с тестом

if Memo_Temp.Lines.Count<4 then

begin

ShowMessage('Откройте файл теста');

Abort;

end;

// --- Узнаем данные о тесте (кол. вопросов и т.д.) ---

PrGetDataTest(Sender);

PrTimeLast:=PrTimeTestData;

PrTimeFull.Min:=PrKolQuestionTestData *PrTimeTestData.Min

+PrKolQuestionTestData *PrTimeTestData.Sec div 60;

PrTimeFull.Sec:=PrKolQuestionTestData *PrTimeTestData.Sec mod 60;

// --- Очистка произвольного порядка вопроса ---

for i:=1 to 255 do

PrOrderQuestion[i]:=0;

tempNomQuestion:=0;

// --- Выбор вопросов в случайном порядке ---

while tempNomQuestion<PrKolQuestionTestData do

begin

randomize;

i:=1+random(PrSymKolQuestionTestData);

for j:=tempNomQuestion+1 downto 1 do

if PrOrderQuestion[j]=i then

begin

i:=0;

break;

end;

if not (i=0) then

begin

PrOrderQuestion[tempNomQuestion+1]:=i;

inc(tempNomQuestion);

end;

end;

PrFillFileds(Sender);

// Заполнение полей формы

LblNameTest.Caption:=(Memo_Temp.Lines[0]);

Lbl_FQuestion.Caption:=PrFormatConvert(PrTimeFull);

Lbl_Last.Caption:=PrFormatConvert(PrTimeLast);

NomQuestion:=1;

MITBegin.Enabled:=False;

MITEnd.Enabled:=True;

GBox.Visible:=True;

PanelButton.Visible:=True;

Timer1.Enabled:=True;

// --- ---

MI_OptionInfoAnsver.Enabled:=True;

end;

// Нажатие кнопки с вариантом ответа

procedure TForm1.PrClickButton(Sender: TObject);

begin

// --- Проверка на правильный ответ на ворос ---

if StrToInt(decrypt(Memo_Temp.Lines[7+6*(PrOrderQuestion[NomQuestion]-1)],30000))=(Sender as TButton).Tag Then

begin

if MI_OptionInfoAnsver.Checked then ShowMessage('Правильно');

inc(PrVAnsverOK);

end

else if MI_OptionInfoAnsver.Checked then ShowMessage('Неправильно');

PrTimeOut(Sender);

end;

procedure TForm1.MIExitClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.MI_OptionInfoAnsverClick(Sender: TObject);

var

Password: string;

begin

if PrPasswordTestData<>'' then begin

PasswordDlg.ShowModal;

if PasswordDlg.Password.text=PrPasswordTestData then begin

MI_OptionInfoAnsver.Checked:= not MI_OptionInfoAnsver.Checked;

PasswordDlg.Password.text:='';

end;

end;

PasswordDlg.Password.text:=''

end;

// --- процедура возращает данные из теста ---

procedure TForm1.PrGetDataTest(Sender: TObject);

var

Temp_String: string;

EndFor: boolean;

Password: string;

b1, b2:boolean;

i, j : byte;

begin

Temp_String:=decrypt(Memo_Temp.Lines[1], 30000);

///ShowMessage(Temp_String);

// --- Пароль ---

for i:=1 to length(Temp_String) do

begin

if ((Temp_String[i]=' ')and not EndFor) then

for j:=i+1 to length(Temp_String) do

if ((Temp_String[j]=' ')and not EndFor) then

begin

if i+1=j then

PrPasswordTestData:=''

else

PrPasswordTestData:=copy(Temp_String,i+1,j-i-1);

EndFor:=true;

end;

end;

// --- Время на 1-н вопрос (мин) ---

i:=pos(':',Temp_String);

while Temp_String[i]<>' ' do

begin

dec(i);

end;

PrTimeTestData.Min:=StrToInt(copy(Temp_String,i+1,pos(':',Temp_String)-i-1));

// --- Время на 1-н вопрос (сек) ---

PrTimeTestData.Sec:=StrToInt(copy(Temp_String,pos(':',Temp_String)+1,length(Temp_String)-pos(':',Temp_String)));

// --- Кол-во тестируемых вопросов ---

PrKolQuestionTestData:=StrToInt(copy(Temp_String, pos('|',Temp_String)+1,

pos(' ',Temp_String)-pos('|',Temp_String) -1));

// --- Суммарное количество вопросов ---

PrSymKolQuestionTestData:=StrToInt(copy(Temp_String, 1,pos('|',Temp_String) -1));;

//Добавил, возможно потом количество попыток можно довести до 3

// пока сразу закрытие

// срабатывает onClose, а там еще один пароль - и все, сразу

// зовет преподавателя, а тот делает правильные выводы

{ if PrPasswordTestData<>'' then

b1:=(Inputquery('Введите пароль', 'Пароль', Password));

if ((b1=false)and (Password<>PrPasswordTestData)) or

((b1=true)and (Password<>PrPasswordTestData)) or

((b1=true)and (Password=PrPasswordTestData))

then

form1.close; }

if PrPasswordTestData<>'' then begin

PasswordDlg.Caption:='Получение доступа к тесту';

PasswordDlg.ShowModal;

if PasswordDlg.Password.text<>PrPasswordTestData then begin

PasswordDlg.Password.text:='';

PriznakExit:=true;

form1.close;

end;

PasswordDlg.Password.text:=''

end;

end;

//

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

var

Password: string;

begin

{ if PrPasswordTestData<>'' then

if InputQuery('Введите пароль', 'Пароль', Password)=true and (Password=PrPasswordTestData)

then

///MI_OptionInfoAnsver.Checked:= not MI_OptionInfoAnsver.Checked;

Action := caFree

else Action := caNone; }

if (PriznakExit=true) then begin

ShowMessage('Неверно задан пароль на доступ к тесту ! Программа завершает работу !');

Action := caFree;

end;

if (PrPasswordTestData<>'') and (PriznakExit=false) then begin

PasswordDlg.Caption:='Закрытие программы тестирования';

PasswordDlg.ShowModal;

if PasswordDlg.Password.text=PrPasswordTestData then begin

PasswordDlg.Password.text:='';

Action := caFree end

else begin Action := caNone; PasswordDlg.Password.text:='';

end;

end;

PasswordDlg.Password.text:='';

end;

//

procedure TForm1.MITEndClick(Sender: TObject);

begin

if PrPasswordTestData<>'' then begin

PasswordDlg.ShowModal;

if PasswordDlg.Password.text=PrPasswordTestData then begin

FormCreate(Sender);

PasswordDlg.Password.text:='';

end;

end;

PasswordDlg.Password.text:=''

end;

end.

unit Unit3;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Buttons;

type

TPasswordDlg = class(TForm)

Label1: TLabel;

Password: TEdit;

OKBtn: TButton;

CancelBtn: TButton;

private

{ Private declarations }

public

{ Public declarations }

end;

var

PasswordDlg: TPasswordDlg;

implementation

uses Unit1;

{$R *.dfm}

end.

unit uEncrypt;

interface

function Decrypt(const S: AnsiString; Key: Word): AnsiString; stdcall; ///расшифровать

function Encrypt(const S: AnsiString; Key: Word): AnsiString; stdcall; ///зашифровать

implementation

const

C1 = 52845;

C2 = 22719;

function Decode(const S: AnsiString): AnsiString;

const

Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,

54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,

3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,

20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,

31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,

46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

0);

var

I: LongInt;

begin

case Length(S) of

2:

begin

I := Map[S[1]] + (Map[S[2]] shl 6);

SetLength(Result, 1);

Move(I, Result[1], Length(Result))

end;

3:

begin

I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);

SetLength(Result, 2);

Move(I, Result[1], Length(Result))

end;

4:

begin

I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +

(Map[S[4]] shl 18);

SetLength(Result, 3);

Move(I, Result[1], Length(Result))

end

end

end;

function PreProcess(const S: AnsiString): AnsiString;

var

SS: AnsiString;

begin

SS := S;

Result := '';

while SS <> '' do

begin

Result := Result + Decode(Copy(SS, 1, 4));

Delete(SS, 1, 4)

end

end;

function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;

var

I: Word;

Seed: Word;

begin

Result := S;

Seed := Key;

for I := 1 to Length(Result) do

begin

Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));

Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)

end

end;

function Decrypt(const S: AnsiString; Key: Word): AnsiString;

begin

Result := InternalDecrypt(PreProcess(S), Key)

end;

function Encode(const S: AnsiString): AnsiString;

const

Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +

'abcdefghijklmnopqrstuvwxyz0123456789+/';

var

I: LongInt;

begin

I := 0;

Move(S[1], I, Length(S));

case Length(S) of

1:

Result := Map[I mod 64] + Map[(I shr 6) mod 64];

2:

Result := Map[I mod 64] + Map[(I shr 6) mod 64] +

Map[(I shr 12) mod 64];

3:

Result := Map[I mod 64] + Map[(I shr 6) mod 64] +

Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]

end

end;

function PostProcess(const S: AnsiString): AnsiString;

var

SS: AnsiString;

begin

SS := S;

Result := '';

while SS <> '' do

begin

Result := Result + Encode(Copy(SS, 1, 3));

Delete(SS, 1, 3)

end

end;

function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;

var

I: Word;

Seed: Word;

begin

Result := S;

Seed := Key;

for I := 1 to Length(Result) do

begin

Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));

Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)

end

end;

function Encrypt(const S: AnsiString; Key: Word): AnsiString;

begin

Result := PostProcess(InternalEncrypt(S, Key))

end;

end.

Размещено на Allbest.ru