1556 lines
54 KiB
ObjectPascal
1556 lines
54 KiB
ObjectPascal
/// Модуль LightPT автоматической легковесной проверки заданий
|
||
unit LightPT;
|
||
{$reference System.Net.Http.dll}
|
||
{$reference System.Security.dll}
|
||
{$reference System.Management.dll}
|
||
uses __RedirectIOMode;
|
||
|
||
// Любые существенные изменения в этом модуле влияют на все Tasks, составленные всеми.
|
||
// Они перестанут компилироваться, что плохо !!!
|
||
|
||
uses System.Management;
|
||
uses System.Security.Cryptography;
|
||
uses System.IO;
|
||
|
||
uses System;
|
||
uses System.Net.Http;
|
||
uses System.Threading.Tasks;
|
||
|
||
// Исключения - для вывода сообщения
|
||
// TaskResult - для базы данных
|
||
// Запоминать исключение в глобальной переменной TaskException - для доп. параметров для БД в формате
|
||
// ПодтипИсключения(парам1,...,парамn)
|
||
// Эту строку также можно писать в БД как доп параметры TaskResultInfo
|
||
// Чем хороши исключения - их можно делать разными с абсолютно разными параметрами
|
||
|
||
const lightptname = 'lightpt.dat';
|
||
|
||
type
|
||
MessageColorT = (MsgColorGreen, MsgColorRed, MsgColorOrange, MsgColorMagenta, MsgColorGray);
|
||
TaskStatus = (NotUnderControl, Solved, IOError, BadSolution, PartialSolution, InitialTask, BadInitialTask, InitialTaskPT4, ErrFix, Demo); // Короткий результат для БД
|
||
|
||
type
|
||
PTException = class(Exception)
|
||
function Info: string; virtual := 'NoInfo';
|
||
end;
|
||
|
||
var
|
||
DoNewLineBeforeMessage := False;
|
||
TaskResult: TaskStatus := NotUnderControl; // Записывается в БД
|
||
TaskResultInfo: string; // доп. информация о результате. Как правило пуста. Или содержит TaskException.Info. Или содержит для Solved и BadSolution информацию о модуле: Robot, Drawman, PT4
|
||
TaskException: PTException := new PTException;
|
||
|
||
WriteInfoCallBack: procedure (LessonName,TaskName,TaskPlatform: string; result: TaskStatus; AdditionalInfo: string);
|
||
|
||
LessonName: string := '';
|
||
TaskNamesMap := new Dictionary<string,string>;
|
||
|
||
ServerAddr := 'https://air.mmcs.sfedu.ru/pascalabc';
|
||
|
||
type
|
||
UserTypeEnum = (None, Student, Teacher, Admin);
|
||
ServerAccessProvider = class
|
||
private
|
||
client: HTTPClient;
|
||
public
|
||
ServerAddr: string;
|
||
auto property ShortFIO: string;
|
||
auto property FullFIO: string;
|
||
auto property Password: string;
|
||
auto property Group: string;
|
||
auto property UserType: UserTypeEnum;
|
||
constructor (ServerAddr: string);
|
||
begin
|
||
Self.ServerAddr := ServerAddr;
|
||
client := new HttpClient();
|
||
client.Timeout := TimeSpan.FromSeconds(10);
|
||
end;
|
||
|
||
function SendPostRequest(FullFIO, Password, LessonName, TaskName, TaskPlatform, TaskResult, TaskResultInfo: string): Task<string>;
|
||
begin
|
||
var values := Dict(
|
||
( 'shortFIO', '' ),
|
||
( 'FIO', FullFIO ),
|
||
( 'taskName', TaskName ),
|
||
( 'lessonName', LessonName ),
|
||
( 'taskPlatform', TaskPlatform ),
|
||
( 'taskResult', TaskResult ),
|
||
( 'taskResultInfo', TaskResultInfo ),
|
||
( 'content', '' ),
|
||
( 'password', Password )
|
||
);
|
||
var content := new FormUrlEncodedContent(values);
|
||
var response := client.PostAsync(ServerAddr + '/add.php', content);
|
||
Result := response.Result.Content.ReadAsStringAsync();
|
||
end;
|
||
end;
|
||
|
||
InputCountException = class(PTException) // Ровно Count
|
||
Count: integer; // Count - сколько введено
|
||
n: integer; // n - сколько требуется ввести
|
||
constructor(Count, n: integer);
|
||
begin
|
||
Self.Count := Count;
|
||
Self.n := n;
|
||
TaskResult := IOError;
|
||
TaskException := Self;
|
||
end;
|
||
|
||
function Info: string; override := $'InputCount({Count},{n})';
|
||
end;
|
||
InputCount2Exception = class(PTException) // Не меньше Count
|
||
Count: integer; // Count - сколько введено
|
||
i: integer; // i - какой номер требуется ввести (с нуля)
|
||
constructor(Count, i: integer);
|
||
begin
|
||
Self.Count := Count;
|
||
Self.i := i;
|
||
TaskResult := IOError;
|
||
TaskException := Self;
|
||
end;
|
||
|
||
function Info: string; override := $'InputCount2({Count},{i})';
|
||
end;
|
||
InputTypeException = class(PTException)
|
||
n: integer; // номер параметра
|
||
ExpectedType, ActualType: string;
|
||
constructor(n: integer; ExpectedType, ActualType: string);
|
||
begin
|
||
Self.n := n;
|
||
Self.ExpectedType := ExpectedType;
|
||
Self.ActualType := ActualType;
|
||
TaskResult := IOError;
|
||
TaskException := Self;
|
||
end;
|
||
|
||
function Info: string; override := $'InputType({n},{ExpectedType},{ActualType})';
|
||
end;
|
||
OutputCountException = class(PTException) // Ровно Count
|
||
Count: integer; // Count - сколько выведено
|
||
n: integer; // n - сколько требуется вывести
|
||
constructor(Count, n: integer);
|
||
begin
|
||
Self.Count := Count;
|
||
Self.n := n;
|
||
TaskResult := IOError;
|
||
TaskException := Self;
|
||
end;
|
||
|
||
function Info: string; override := $'OutputCount({Count},{n})';
|
||
end;
|
||
OutputCount2Exception = class(PTException) // Ровно Count
|
||
Count: integer; // Count - сколько выведено
|
||
i: integer; // n - какой номер требуется вывести
|
||
constructor(Count, i: integer);
|
||
begin
|
||
Self.Count := Count;
|
||
Self.i := i;
|
||
TaskResult := IOError;
|
||
TaskException := Self;
|
||
end;
|
||
|
||
function Info: string; override := $'Output2Count({Count},{i})';
|
||
end;
|
||
OutputTypeException = class(PTException)
|
||
n: integer; // номер параметра
|
||
ExpectedType, ActualType: string;
|
||
constructor(n: integer; ExpectedType, ActualType: string);
|
||
begin
|
||
Self.n := n;
|
||
Self.ExpectedType := ExpectedType;
|
||
Self.ActualType := ActualType;
|
||
TaskResult := IOError;
|
||
TaskException := Self;
|
||
end;
|
||
|
||
function Info: string; override := $'OutputType({n},{ExpectedType},{ActualType})';
|
||
end;
|
||
|
||
ObjectList = class
|
||
lst := new List<object>;
|
||
public
|
||
static function New: ObjectList := ObjectList.Create;
|
||
procedure Add(o: object) := lst.Add(o);
|
||
function AddRange(sq: sequence of integer): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end;
|
||
function AddRange(sq: sequence of real): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end;
|
||
function AddRange(sq: sequence of string): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end;
|
||
function AddRange(sq: sequence of char): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end;
|
||
function AddRange(sq: sequence of boolean): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end;
|
||
function AddRange(sq: sequence of object): ObjectList; begin lst.AddRange(sq); Result := Self end;
|
||
function AddRange(sq: sequence of System.Type): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end;
|
||
function AddFill(n: integer; elem: object): ObjectList; begin lst.AddRange(ArrFill(n,elem)); Result := Self end;
|
||
function AddArithm(n: integer; a0,step: integer): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x+step).Select(x -> object(x))); Result := Self end;
|
||
function AddArithm(n: integer; a0,step: real): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x+step).Select(x -> object(x))); Result := Self end;
|
||
function AddFib(n: integer): ObjectList; begin lst.AddRange(ArrGen(n,1,1,(x,y)->x+y).Select(x -> object(x))); Result := Self end;
|
||
function AddGeom(n: integer; a0,step: integer): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x*step).Select(x -> object(x))); Result := Self end;
|
||
function AddGeom(n: integer; a0,step: real): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x*step).Select(x -> object(x))); Result := Self end;
|
||
end;
|
||
|
||
var
|
||
OutputString := new StringBuilder;
|
||
OutputList := new List<object>;
|
||
InputList := new List<object>;
|
||
InitialOutputList := new List<object>; // тут только типы и количество
|
||
InitialInputList := new List<object>; // тут только типы и количество
|
||
|
||
CheckTask: procedure(name: string);
|
||
|
||
Cur := 0;
|
||
|
||
var TaskName := ExtractFileName(System.Environment.GetCommandLineArgs[0]).Replace('.exe', '');
|
||
|
||
// Сервисные функции
|
||
|
||
function IsPT := System.Type.GetType('PT4.PT4') <> nil;
|
||
|
||
function IsRobot := System.Type.GetType('RobotField.RobotField');
|
||
|
||
function IsDrawman := System.Type.GetType('DrawManField.DrawManField');
|
||
|
||
function cInt := typeof(integer);
|
||
function cRe := typeof(real);
|
||
function cStr := typeof(string);
|
||
function cBool := typeof(boolean);
|
||
function cChar := typeof(char);
|
||
|
||
/// Полный путь к папке auth-файла
|
||
function FindAuthDat: string;
|
||
begin
|
||
var auth := 'auth.dat';
|
||
Result := '';
|
||
// В текущем каталоге
|
||
if FileExists(auth) then
|
||
Result := ExpandFileName(auth)
|
||
// Если нет, в каталоге уровня выше
|
||
else if FileExists(System.IO.Path.Combine('..',auth)) then
|
||
begin
|
||
Result := ExpandFileName(System.IO.Path.Combine('..',auth))
|
||
end
|
||
// Если нет, в корневом каталоге сетевого диска - Это не работает на старых Win 10 куда не устанавливается NET 4/7/1
|
||
{else begin
|
||
var fullname := ExpandFileName(auth);
|
||
var drive := ExtractFileDrive(fullname);
|
||
var di := new System.IO.DriveInfo(drive);
|
||
if di.DriveType = System.IO.DriveType.Network then
|
||
begin
|
||
var af := System.IO.Path.Combine(di.RootDirectory.FullName,auth);
|
||
if FileExists(af) then
|
||
Result := af;
|
||
end
|
||
end;}
|
||
end;
|
||
|
||
// Шифрование-дешифрование
|
||
|
||
function ProcessorId: string;
|
||
begin
|
||
var mbs := new ManagementObjectSearcher('Select ProcessorId From Win32_processor');
|
||
var mbsList := mbs.Get();
|
||
Result := '';
|
||
foreach var mo: ManagementObject in mbsList do
|
||
begin
|
||
var pId := mo['ProcessorId'];
|
||
if pId <> nil then
|
||
Result := pId.ToString()
|
||
else Result := 'AAAAAAAAAAAAAAAA';
|
||
break;
|
||
end;
|
||
end;
|
||
|
||
function Encrypt(src: string): array of byte; // записать в файл
|
||
begin
|
||
var ae := Aes.Create();
|
||
var key := Encoding.UTF8.GetBytes(ProcessorId);
|
||
var crypt := ae.CreateEncryptor(key, key);
|
||
var ms := new MemoryStream();
|
||
var cs := new CryptoStream(ms, crypt, CryptoStreamMode.Write);
|
||
var sw := new StreamWriter(cs);
|
||
sw.Write(src);
|
||
sw.Close;
|
||
cs.Close;
|
||
ms.Close;
|
||
Result := ms.ToArray;
|
||
end;
|
||
|
||
function Decrypt(data: array of byte): string;
|
||
begin
|
||
if data = nil then
|
||
begin
|
||
Result := '';
|
||
exit
|
||
end;
|
||
var ae := Aes.Create();
|
||
var key := Encoding.UTF8.GetBytes(ProcessorId);
|
||
var crypt := ae.CreateDecryptor(key, key);
|
||
var ms := new MemoryStream(data);
|
||
var cs := new CryptoStream(ms, crypt, CryptoStreamMode.Read);
|
||
var sr := new StreamReader(cs);
|
||
var text := sr.ReadToEnd;
|
||
sr.Close;
|
||
cs.Close;
|
||
ms.Close;
|
||
Result := text;
|
||
end;
|
||
|
||
procedure CheckInitialIO;
|
||
begin
|
||
if (OutputList.Count = InitialOutputList.Count) and (InputList.Count = InitialInputList.Count) then
|
||
TaskResult := InitialTask
|
||
else if (InputList.Count < InitialInputList.Count) or (InputList.Count = InitialInputList.Count) and (OutputList.Count < InitialOutputList.Count) then
|
||
TaskResult := BadInitialTask;
|
||
end;
|
||
|
||
{function CheckBadInitialTask: boolean;
|
||
begin
|
||
Result := (InputList.Count < InitialInputList.Count) or (InputList.Count = InitialInputList.Count) and (OutputList.Count < InitialOutputList.Count);
|
||
end;}
|
||
|
||
procedure InitialOutput(params a: array of object);
|
||
begin
|
||
InitialOutputList.Clear;
|
||
InitialOutputList.AddRange(a);
|
||
end;
|
||
|
||
procedure InitialInput(params a: array of object);
|
||
begin
|
||
InitialInputList.Clear;
|
||
InitialInputList.AddRange(a);
|
||
end;
|
||
|
||
function CompareValues(o1, o2: Object): boolean;
|
||
begin
|
||
if (o1 is real) and (o2 is real) then
|
||
begin
|
||
var r1 := real(o1);
|
||
var r2 := real(o2);
|
||
Result := Abs(r1 - r2) < 0.0001;
|
||
exit;
|
||
end;
|
||
Result := o1.Equals(o2);
|
||
end;
|
||
|
||
function CompareArrValues(a,lst: array of object): boolean;
|
||
begin
|
||
Result := True;
|
||
if a.Length <> OutputList.Count then
|
||
Result := False;
|
||
for var i := 0 to a.Length - 1 do
|
||
if not CompareValues(a[i], lst[i]) then
|
||
begin
|
||
Result := False;
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
function CompareValuesWithOutput(params a: array of object): boolean := CompareArrValues(a,OutputList.ToArray);
|
||
|
||
procedure CheckInitialOutputValues(params a: array of object);
|
||
begin
|
||
if CompareArrValues(a,OutputList.ToArray) then
|
||
TaskResult := InitialTask;
|
||
end;
|
||
|
||
// По сути отдельные функции - это неправильно. Необходим CheckInitialInputOutput
|
||
procedure CheckInitialOutput(params a: array of object);
|
||
begin
|
||
InitialOutput(a);
|
||
CheckInitialIO;
|
||
end;
|
||
|
||
procedure CheckInitialInput(params a: array of object);
|
||
begin
|
||
InitialInput(a);
|
||
CheckInitialIO;
|
||
end;
|
||
|
||
procedure CheckInitialOutputSeq(a: sequence of System.Type) := CheckInitialOutput(a.Select(x->object(x)).ToArray);
|
||
|
||
procedure CheckInitialInputSeq(a: sequence of System.Type) := CheckInitialInput(a.Select(x->object(x)).ToArray);
|
||
|
||
procedure CheckInputCount(n: integer);
|
||
begin
|
||
if InputList.Count <> n then
|
||
raise new InputCountException(InputList.Count, n)
|
||
end;
|
||
|
||
procedure CheckInput2Count(i: integer);
|
||
begin
|
||
if InputList.Count <= i then
|
||
raise new InputCount2Exception(InputList.Count, i + 1)
|
||
end;
|
||
|
||
procedure CheckOutput2Count(i: integer);
|
||
begin
|
||
if OutputList.Count <= i then
|
||
raise new OutputCount2Exception(OutputList.Count, i + 1)
|
||
end;
|
||
|
||
function IsInt(i: integer) := InputList[i] is integer;
|
||
function IsRe(i: integer) := InputList[i] is real;
|
||
function IsStr(i: integer) := InputList[i] is string;
|
||
function IsBoo(i: integer) := InputList[i] is boolean;
|
||
function IsChr(i: integer) := InputList[i] is char;
|
||
|
||
function OutIsInt(i: integer) := OutputList[i] is integer;
|
||
function OutIsRe(i: integer) := OutputList[i] is real;
|
||
function OutIsStr(i: integer) := OutputList[i] is string;
|
||
function OutIsBoo(i: integer) := OutputList[i] is boolean;
|
||
function OutIsChr(i: integer) := OutputList[i] is char;
|
||
|
||
|
||
function Int(i: integer): integer;
|
||
begin
|
||
CheckInput2Count(i);
|
||
if not IsInt(i) then
|
||
raise new InputTypeException(i + 1, 'integer', TypeName(InputList[i]));
|
||
Result := integer(InputList[i]);
|
||
end;
|
||
|
||
function Re(i: integer): real;
|
||
begin
|
||
CheckInput2Count(i);
|
||
if not IsRe(i) then
|
||
raise new InputTypeException(i + 1, 'real', TypeName(InputList[i]));
|
||
Result := real(InputList[i]);
|
||
end;
|
||
|
||
function Str(i: integer): string;
|
||
begin
|
||
CheckInput2Count(i);
|
||
if not IsStr(i) then
|
||
raise new InputTypeException(i + 1, 'string', TypeName(InputList[i]));
|
||
Result := string(InputList[i]);
|
||
end;
|
||
|
||
function Boo(i: integer): boolean;
|
||
begin
|
||
CheckInput2Count(i);
|
||
if not IsBoo(i) then
|
||
raise new InputTypeException(i + 1, 'boolean', TypeName(InputList[i]));
|
||
Result := boolean(InputList[i]);
|
||
end;
|
||
|
||
function Chr(i: integer): char;
|
||
begin
|
||
CheckInput2Count(i);
|
||
if not IsChr(i) then
|
||
raise new InputTypeException(i + 1, 'char', TypeName(InputList[i]));
|
||
Result := char(InputList[i]);
|
||
end;
|
||
|
||
function OutAsInt(i: integer): integer;
|
||
begin
|
||
CheckOutput2Count(i);
|
||
if not OutIsInt(i) then
|
||
raise new OutputTypeException(i + 1, 'integer', TypeName(OutputList[i]));
|
||
Result := integer(OutputList[i]);
|
||
end;
|
||
|
||
function OutAsRe(i: integer): real;
|
||
begin
|
||
CheckOutput2Count(i);
|
||
if not OutIsRe(i) then
|
||
raise new OutputTypeException(i + 1, 'real', TypeName(OutputList[i]));
|
||
Result := real(OutputList[i]);
|
||
end;
|
||
|
||
function OutAsBoo(i: integer): boolean;
|
||
begin
|
||
CheckOutput2Count(i);
|
||
if not OutIsBoo(i) then
|
||
raise new OutputTypeException(i + 1, 'boolean', TypeName(OutputList[i]));
|
||
Result := boolean(OutputList[i]);
|
||
end;
|
||
|
||
function OutAsChr(i: integer): char;
|
||
begin
|
||
CheckOutput2Count(i);
|
||
if not OutIsChr(i) then
|
||
raise new OutputTypeException(i + 1, 'char', TypeName(OutputList[i]));
|
||
Result := char(OutputList[i]);
|
||
end;
|
||
|
||
function OutAsStr(i: integer): string;
|
||
begin
|
||
CheckOutput2Count(i);
|
||
if not OutIsStr(i) then
|
||
raise new OutputTypeException(i + 1, 'string', TypeName(OutputList[i]));
|
||
Result := string(OutputList[i]);
|
||
end;
|
||
|
||
function Int: integer;
|
||
begin
|
||
Result := Int(Cur);
|
||
Cur += 1;
|
||
end;
|
||
|
||
function Re: real;
|
||
begin
|
||
Result := Re(Cur);
|
||
Cur += 1;
|
||
end;
|
||
|
||
function Str: string;
|
||
begin
|
||
Result := Str(Cur);
|
||
Cur += 1;
|
||
end;
|
||
|
||
function Boo: boolean;
|
||
begin
|
||
Result := Boo(Cur);
|
||
Cur += 1;
|
||
end;
|
||
|
||
function Chr: char;
|
||
begin
|
||
Result := Chr(Cur);
|
||
Cur += 1;
|
||
end;
|
||
|
||
function Int2: (integer, integer) := (Int, Int);
|
||
|
||
function Re2: (real, real) := (Re, Re);
|
||
|
||
function IntArr(n: integer): array of integer := (1..n).Select(x -> Int).ToArray;
|
||
|
||
function ReArr(n: integer): array of real := (1..n).Select(x -> Re).ToArray;
|
||
|
||
// функции, возвращающие входные и выходные списки, а также их срезы, приведенные к нужному типу
|
||
|
||
function InputListAsIntegers: array of integer := InputList.Select((x,i) -> Int(i)).ToArray;
|
||
function InputListAsReals: array of real := InputList.Select((x,i) -> Re(i)).ToArray;
|
||
function InputListAsBooleans: array of boolean := InputList.Select((x,i) -> Boo(i)).ToArray;
|
||
function InputListAsChars: array of char := InputList.Select((x,i) -> Chr(i)).ToArray;
|
||
function InputListAsStrings: array of string := InputList.Select((x,i) -> Str(i)).ToArray;
|
||
|
||
function OutputListAsIntegers: array of integer := OutputList.Select((x,i) -> OutAsInt(i)).ToArray;
|
||
function OutputListAsReals: array of real := OutputList.Select((x,i) -> OutAsRe(i)).ToArray;
|
||
function OutputListAsBooleans: array of boolean := OutputList.Select((x,i) -> OutAsBoo(i)).ToArray;
|
||
function OutputListAsChars: array of char := OutputList.Select((x,i) -> OutAsChr(i)).ToArray;
|
||
function OutputListAsStrings: array of string := OutputList.Select((x,i) -> OutAsStr(i)).ToArray;
|
||
|
||
function InputListSliceAsIntegers(a,b: integer): array of integer := (a..b).Select(i->Int(i)).ToArray;
|
||
function InputListSliceAsReals(a,b: integer): array of real := (a..b).Select(i->Re(i)).ToArray;
|
||
function InputListSliceAsBooleans(a,b: integer): array of boolean := (a..b).Select(i->Boo(i)).ToArray;
|
||
function InputListSliceAsChars(a,b: integer): array of char := (a..b).Select(i->Chr(i)).ToArray;
|
||
function InputListSliceAsStrings(a,b: integer): array of string := (a..b).Select(i->Str(i)).ToArray;
|
||
|
||
function OutputListSliceAsIntegers(a,b: integer): array of integer := (a..b).Select(i->OutAsInt(i)).ToArray;
|
||
function OutputListSliceAsReals(a,b: integer): array of real := (a..b).Select(i->OutAsRe(i)).ToArray;
|
||
function OutputListSliceAsBooleans(a,b: integer): array of boolean := (a..b).Select(i->OutAsBoo(i)).ToArray;
|
||
function OutputListSliceAsChars(a,b: integer): array of char := (a..b).Select(i->OutAsChr(i)).ToArray;
|
||
function OutputListSliceAsStrings(a,b: integer): array of string := (a..b).Select(i->OutAsStr(i)).ToArray;
|
||
|
||
function ConvertOne(ob: Object): Object;
|
||
begin
|
||
Result := ob;
|
||
if ob is string then
|
||
begin
|
||
var s := string(ob);
|
||
var ival: integer;
|
||
var rval: real;
|
||
if s.TryToInteger(ival) then
|
||
Result := ival
|
||
else if s.TryToReal(rval) then
|
||
Result := rval
|
||
end
|
||
end;
|
||
|
||
procedure ConvertStringsToNumbersInOutputList;
|
||
begin
|
||
for var i:=0 to OutputList.Count - 1 do
|
||
OutputList[i] := ConvertOne(OutputList[i]);
|
||
end;
|
||
|
||
// -------------- Переопределенные функции с заполнением ввода и вывода
|
||
|
||
function Random(a, b: integer): integer;
|
||
begin
|
||
Result := PABCSystem.Random(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result);
|
||
end;
|
||
|
||
function Random: real;
|
||
begin
|
||
Result := PABCSystem.Random;
|
||
if IsPT then exit;
|
||
InputList.Add(Result);
|
||
end;
|
||
|
||
function Random(a, b: real): real;
|
||
begin
|
||
Result := PABCSystem.Random(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result);
|
||
end;
|
||
|
||
function Random(a, b: char): char;
|
||
begin
|
||
Result := PABCSystem.Random(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result);
|
||
end;
|
||
|
||
function Random2(a, b: integer): (integer, integer);
|
||
begin
|
||
Result := PABCSystem.Random2(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result[0]);
|
||
InputList.Add(Result[1]);
|
||
end;
|
||
|
||
function Random2(a, b: real): (real, real);
|
||
begin
|
||
Result := PABCSystem.Random2(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result[0]);
|
||
InputList.Add(Result[1]);
|
||
end;
|
||
|
||
function Random2(a, b: char): (char, char);
|
||
begin
|
||
Result := PABCSystem.Random2(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result);
|
||
end;
|
||
|
||
function Random3(a, b: integer): (integer, integer, integer);
|
||
begin
|
||
Result := PABCSystem.Random3(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result[0]);
|
||
InputList.Add(Result[1]);
|
||
InputList.Add(Result[2]);
|
||
end;
|
||
|
||
function Random3(a, b: real): (real, real, real);
|
||
begin
|
||
Result := PABCSystem.Random3(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result[0]);
|
||
InputList.Add(Result[1]);
|
||
InputList.Add(Result[2]);
|
||
end;
|
||
|
||
function Random3(a, b: char): (char, char, char);
|
||
begin
|
||
Result := PABCSystem.Random3(a, b);
|
||
if IsPT then exit;
|
||
InputList.Add(Result[0]);
|
||
InputList.Add(Result[1]);
|
||
InputList.Add(Result[2]);
|
||
end;
|
||
|
||
/// Возвращает массив размера n, заполненный случайными целыми значениями
|
||
function ArrRandomInteger(n: integer; a: integer; b: integer): array of integer;
|
||
begin
|
||
Result := PABCSystem.ArrRandomInteger(n, a, b);
|
||
if IsPT then exit;
|
||
for var i:=0 to n-1 do
|
||
InputList.Add(Result[i]);
|
||
end;
|
||
|
||
/// Возвращает массив размера n, заполненный случайными целыми значениями
|
||
function ArrRandomInteger(n: integer): array of integer := ArrRandomInteger(n,0,100);
|
||
|
||
/// Возвращает массив размера n, заполненный случайными вещественными значениями
|
||
function ArrRandomReal(n: integer; a: real; b: real): array of real;
|
||
begin
|
||
Result := PABCSystem.ArrRandomReal(n, a, b);
|
||
if IsPT then exit;
|
||
for var i:=0 to n-1 do
|
||
InputList.Add(Result[i]);
|
||
end;
|
||
|
||
/// Возвращает массив размера n, заполненный случайными вещественными значениями
|
||
function ArrRandomReal(n: integer): array of real := ArrRandomReal(n,0,10);
|
||
|
||
/// Возвращает массив из count элементов, заполненных значениями gen(i)
|
||
function ArrGen<T>(count: integer; gen: integer->T): array of T;
|
||
begin
|
||
Result := PABCSystem.ArrGen(count,gen);
|
||
if IsPT then exit;
|
||
for var i:=0 to Result.Length-1 do
|
||
InputList.Add(Result[i]);
|
||
end;
|
||
|
||
/// Возвращает массив из count элементов, заполненных значениями gen(i), начиная с i=from
|
||
function ArrGen<T>(count: integer; gen: integer->T; from: integer): array of T;
|
||
begin
|
||
Result := PABCSystem.ArrGen(count,gen,from);
|
||
if IsPT then exit;
|
||
for var i:=0 to Result.Length-1 do
|
||
InputList.Add(Result[i]);
|
||
end;
|
||
|
||
/// Возвращает массив из count элементов, начинающихся с first, с функцией next перехода от предыдущего к следующему
|
||
function ArrGen<T>(count: integer; first: T; next: T->T): array of T;
|
||
begin
|
||
Result := PABCSystem.ArrGen(count,first,next);
|
||
if IsPT then exit;
|
||
for var i:=0 to Result.Length-1 do
|
||
InputList.Add(Result[i]);
|
||
end;
|
||
|
||
/// Возвращает массив из count элементов, начинающихся с first и second, с функцией next перехода от двух предыдущих к следующему
|
||
function ArrGen<T>(count: integer; first, second: T; next: (T,T) ->T): array of T;
|
||
begin
|
||
Result := PABCSystem.ArrGen(count,first,second,next);
|
||
if IsPT then exit;
|
||
for var i:=0 to Result.Length-1 do
|
||
InputList.Add(Result[i]);
|
||
end;
|
||
|
||
{/// Возвращает массив из n целых, введенных с клавиатуры
|
||
function ReadArrInteger(n: integer): array of integer;
|
||
begin
|
||
Result := PABCSystem.ReadArrInteger(n); // и всё!!! Данные в InputList уже внесены!
|
||
end;
|
||
|
||
/// Возвращает массив из n вещественных, введенных с клавиатуры
|
||
function ReadArrReal(n: integer): array of real;
|
||
begin
|
||
Result := PABCSystem.ReadArrReal(n);
|
||
end;
|
||
|
||
/// Возвращает массив из n строк, введенных с клавиатуры
|
||
function ReadArrString(n: integer): array of string;
|
||
begin
|
||
Result := PABCSystem.ReadArrString(n);
|
||
end;
|
||
|
||
/// Возвращает матрицу m на n целых, введенных с клавиатуры
|
||
function ReadMatrInteger(m, n: integer): array [,] of integer;
|
||
begin
|
||
Result := PABCSystem.ReadMatrInteger(m,n); // и всё!!! Данные в InputList уже внесены!
|
||
end;
|
||
|
||
/// Возвращает матрицу m на n вещественных, введенных с клавиатуры
|
||
function ReadMatrReal(m, n: integer): array [,] of real;
|
||
begin
|
||
Result := PABCSystem.ReadMatrReal(m,n);
|
||
end;}
|
||
|
||
/// Возвращает двумерный массив размера m x n, заполненный случайными целыми значениями
|
||
function MatrRandomInteger(m: integer; n: integer; a: integer; b: integer): array [,] of integer;
|
||
begin
|
||
Result := PABCSystem.MatrRandomInteger(m,n,a,b);
|
||
if IsPT then exit;
|
||
foreach var x in Result.ElementsByRow do
|
||
InputList.Add(x);
|
||
end;
|
||
|
||
/// Возвращает двумерный массив размера m x n, заполненный случайными целыми значениями
|
||
function MatrRandomInteger(m: integer; n: integer): array [,] of integer := MatrRandomInteger(m,n,0,100);
|
||
|
||
/// Возвращает двумерный массив размера m x n, заполненный случайными вещественными значениями
|
||
function MatrRandomReal(m: integer; n: integer; a: real; b: real): array [,] of real;
|
||
begin
|
||
Result := PABCSystem.MatrRandomReal(m,n,a,b);
|
||
if IsPT then exit;
|
||
foreach var x in Result.ElementsByRow do
|
||
InputList.Add(x);
|
||
end;
|
||
|
||
/// Возвращает двумерный массив размера m x n, заполненный случайными вещественными значениями
|
||
function MatrRandomReal(m: integer; n: integer): array [,] of real := MatrRandomReal(m,n,0,10);
|
||
|
||
/// Возвращает двумерный массив размера m x n, заполненный элементами gen(i,j)
|
||
function MatrGen<T>(m, n: integer; gen: (integer,integer)->T): array [,] of T;
|
||
begin
|
||
Result := PABCSystem.MatrGen(m,n,gen);
|
||
if IsPT then exit;
|
||
foreach var x in Result.ElementsByRow do
|
||
InputList.Add(x);
|
||
end;
|
||
|
||
{function ReadString: string;
|
||
begin
|
||
Result := PABCSystem.ReadString;
|
||
if IsPT then exit;
|
||
InputList.Add(Result);
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
function ReadlnString := ReadString;
|
||
|
||
function ReadString2 := (ReadString, ReadString);
|
||
|
||
function ReadlnString2 := ReadString2;}
|
||
|
||
function ReadInteger(prompt: string): integer;
|
||
begin
|
||
Result := PABCSystem.ReadInteger(prompt);
|
||
if IsPT then exit;
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
function ReadInteger2(prompt: string): (integer, integer);
|
||
begin
|
||
Result := PABCSystem.ReadInteger2(prompt);
|
||
if IsPT then exit;
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
procedure Print(params args: array of object);
|
||
begin
|
||
foreach var ob in args do
|
||
begin
|
||
PABCSystem.Print(ob);
|
||
if not IsPT then
|
||
OutputList.RemoveAt(OutputList.Count - 1)
|
||
end;
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure Println(params args: array of object);
|
||
begin
|
||
Print(args);
|
||
Writeln;
|
||
if IsPT then exit;
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
procedure Print(ob: object);
|
||
begin
|
||
PABCSystem.Print(ob);
|
||
if IsPT then exit;
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure Print(s: string);
|
||
begin
|
||
PABCSystem.Print(s);
|
||
if IsPT then exit;
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure Print(c: char);
|
||
begin
|
||
PABCSystem.Print(object(c));
|
||
if IsPT then exit;
|
||
OutputList.RemoveAt(OutputList.Count - 1);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
type
|
||
IOLightSystem = class(__ReadSignalOISystem)
|
||
public
|
||
procedure write(obj: object); override;
|
||
begin
|
||
inherited write(obj);
|
||
OutputString += _ObjectToString(obj);
|
||
OutputList += obj;
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure writeln; override;
|
||
begin
|
||
inherited writeln;
|
||
OutputString += NewLine;
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
function ReadLine: string; override;
|
||
begin
|
||
Result := inherited ReadLine;
|
||
InputList.Add(Result);
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
procedure readln; override;
|
||
begin
|
||
inherited readln;
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
procedure read(var x: integer); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: real); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: char); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: string); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: byte); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: shortint); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: smallint); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: word); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: longword); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: int64); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: uint64); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: single); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: boolean); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
|
||
procedure read(var x: BigInteger); override;
|
||
begin
|
||
inherited Read(x);
|
||
InputList.Add(x);
|
||
DoNewLineBeforeMessage := True;
|
||
end;
|
||
end;
|
||
|
||
// конец переопределенных функций с заполнением ввода-вывода
|
||
|
||
function ToObjArray(a: array of integer) := a.Select(x -> object(x)).ToArray;
|
||
|
||
function ToObjArray(a: array of real) := a.Select(x -> object(x)).ToArray;
|
||
|
||
function ToObjArray(a: array of string) := a.Select(x -> object(x)).ToArray;
|
||
|
||
function ToObjArray(a: array of char) := a.Select(x -> object(x)).ToArray;
|
||
|
||
function ToObjArray(a: array of boolean) := a.Select(x -> object(x)).ToArray;
|
||
|
||
procedure CompareTypeWithOutput(params a: array of System.Type);
|
||
begin
|
||
TaskResult := Solved;
|
||
var mn := Min(a.Length, OutputList.Count);
|
||
for var i := 0 to mn - 1 do
|
||
if a[i] <> OutputList[i].GetType then
|
||
raise new OutputTypeException(i + 1, TypeToTypeName(a[i]), TypeName(OutputList[i]));
|
||
if a.Length <> OutputList.Count then
|
||
raise new OutputCountException(OutputList.Count, a.Length);
|
||
end;
|
||
|
||
procedure CheckOutput(params arr: array of object);
|
||
begin
|
||
if (TaskResult = InitialTask) or (TaskResult = BadInitialTask) then
|
||
exit;
|
||
|
||
var mn := Min(arr.Length, OutputList.Count);
|
||
TaskResult := Solved;
|
||
// Несоответствие типов
|
||
for var i := 0 to mn - 1 do
|
||
begin
|
||
if (arr[i].GetType.Name = 'RuntimeType') and (arr[i] <> OutputList[i].GetType) then
|
||
raise new OutputTypeException(i + 1, TypeToTypeName(arr[i] as System.Type), TypeName(OutputList[i]))
|
||
else if (arr[i].GetType.Name <> 'RuntimeType') and (arr[i].GetType <> OutputList[i].GetType) then
|
||
raise new OutputTypeException(i + 1, TypeName(arr[i]), TypeName(OutputList[i]));
|
||
end;
|
||
|
||
// Несоответствие количества выводимых параметров
|
||
if arr.Length <> OutputList.Count then
|
||
raise new OutputCountException(OutputList.Count, arr.Length);
|
||
|
||
// Несоответствие значений
|
||
for var i := 0 to mn - 1 do
|
||
if (arr[i].GetType.Name <> 'RuntimeType') and not CompareValues(arr[i], OutputList[i]) then
|
||
begin
|
||
TaskResult := BadSolution; // Если типы разные, то IOErrorSolution
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
procedure CheckOutputAfterInitial(params arr: array of object); // проверить только то, что после исходного вывода
|
||
begin
|
||
if (TaskResult = InitialTask) or (TaskResult = BadInitialTask) then
|
||
exit;
|
||
|
||
// Здесь всегда OutputList.Count > InitialOutputList.Count
|
||
// Если arr.Length > OutputList.Count - InitialOutputList.Count, то мы не вывели часть данных
|
||
// Если arr.Length < OutputList.Count - InitialOutputList.Count, то мы вывели больше чем надо
|
||
|
||
if arr.Length <> OutputList.Count - InitialOutputList.Count then
|
||
raise new OutputCountException(OutputList.Count, InitialOutputList.Count + arr.Length);
|
||
|
||
TaskResult := Solved;
|
||
// Несоответствие типов
|
||
var a := OutputList.Count - arr.Length;
|
||
for var i := a to OutputList.Count - 1 do
|
||
begin
|
||
if (arr[i-a].GetType.Name = 'RuntimeType') and (arr[i-a] <> OutputList[i].GetType) then
|
||
raise new OutputTypeException(i + 1, TypeToTypeName(arr[i-a] as System.Type), TypeName(OutputList[i]))
|
||
else if (arr[i-a].GetType.Name <> 'RuntimeType') and (arr[i-a].GetType <> OutputList[i].GetType) then
|
||
raise new OutputTypeException(i + 1, TypeName(arr[i-a]), TypeName(OutputList[i]));
|
||
end;
|
||
|
||
// Несоответствие значений
|
||
for var i := a to OutputList.Count - 1 do
|
||
if (arr[i-a].GetType.Name <> 'RuntimeType') and not CompareValues(arr[i-a], OutputList[i]) then
|
||
begin
|
||
TaskResult := BadSolution; // Если типы разные, то IOErrorSolution
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
/// Не меняет TaskResult если типы правильные
|
||
procedure CheckInputTypes(a: array of System.Type);
|
||
begin
|
||
// Несоответствие количества вводимых параметров
|
||
if a.Length <> InputList.Count then
|
||
raise new InputCountException(InputList.Count, a.Length);
|
||
for var i := 0 to a.Length - 1 do
|
||
if a[i] <> InputList[i].GetType then
|
||
raise new InputTypeException(i + 1, TypeToTypeName(a[i]), TypeName(InputList[i]));
|
||
end;
|
||
|
||
/// Смноним CheckInputTypes
|
||
procedure CheckInput(a: array of System.Type) := CheckInputTypes(a);
|
||
|
||
procedure CheckInput(seq: sequence of System.Type) := CheckInputTypes(seq.ToArray);
|
||
|
||
procedure CheckOutputSeq(a: sequence of integer) := CheckOutput(ToObjArray(a.ToArray));
|
||
|
||
procedure CheckOutputSeq(a: sequence of real) := CheckOutput(ToObjArray(a.ToArray));
|
||
|
||
procedure CheckOutputSeq(a: sequence of string) := CheckOutput(ToObjArray(a.ToArray));
|
||
|
||
procedure CheckOutputSeq(a: sequence of char) := CheckOutput(ToObjArray(a.ToArray));
|
||
|
||
procedure CheckOutputSeq(a: sequence of boolean) := CheckOutput(ToObjArray(a.ToArray));
|
||
|
||
procedure CheckOutputSeq(a: sequence of object) := CheckOutput(a.ToArray);
|
||
|
||
procedure CheckOutputSeq(a: ObjectList) := CheckOutput(a.lst.ToArray);
|
||
|
||
procedure CheckOutputAfterInitialSeq(seq: sequence of integer) := CheckOutputAfterInitial(ToObjArray(seq.ToArray));
|
||
procedure CheckOutputAfterInitialSeq(seq: sequence of real) := CheckOutputAfterInitial(ToObjArray(seq.ToArray));
|
||
procedure CheckOutputAfterInitialSeq(seq: sequence of string) := CheckOutputAfterInitial(ToObjArray(seq.ToArray));
|
||
procedure CheckOutputAfterInitialSeq(seq: sequence of boolean) := CheckOutputAfterInitial(ToObjArray(seq.ToArray));
|
||
procedure CheckOutputAfterInitialSeq(seq: sequence of char) := CheckOutputAfterInitial(ToObjArray(seq.ToArray));
|
||
procedure CheckOutputAfterInitialSeq(seq: sequence of object) := CheckOutputAfterInitial(seq.ToArray);
|
||
procedure CheckOutputAfterInitialSeq(seq: ObjectList) := CheckOutputAfterInitial(seq.lst.ToArray);
|
||
|
||
|
||
procedure ClearOutputListFromSpaces;
|
||
begin
|
||
OutputList := OutputList.Where(s -> (not (s is string)) or ((s as string) <> ' ')).ToList;
|
||
end;
|
||
|
||
procedure FilterOnlyNumbers;
|
||
begin
|
||
OutputList := OutputList.Where(x -> (x is integer) or (x is real) or (x is int64)).ToList;
|
||
end;
|
||
|
||
function MsgColorCode(color: MessageColorT): char;
|
||
begin
|
||
Result := #65530; // Black
|
||
case color of
|
||
MsgColorGreen: Result := #65535;
|
||
MsgColorRed: Result := #65534;
|
||
MsgColorOrange: Result := #65533;
|
||
MsgColorMagenta: Result := #65532;
|
||
MsgColorGray: Result := #65531;
|
||
end;
|
||
end;
|
||
|
||
procedure ColoredMessage(msg: string; color: MessageColorT);
|
||
begin
|
||
if DoNewLineBeforeMessage then
|
||
Console.WriteLine;
|
||
Console.WriteLine(MsgColorCode(color) + msg);
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
procedure ColoredMessage(msg: string);
|
||
begin
|
||
if DoNewLineBeforeMessage then
|
||
Console.WriteLine;
|
||
Console.WriteLine(MsgColorCode(MsgColorRed) + msg);
|
||
DoNewLineBeforeMessage := False;
|
||
end;
|
||
|
||
function NValues(n: integer): string;
|
||
begin
|
||
case n of
|
||
1: Result := n + ' значение';
|
||
2, 3, 4: Result := n + ' значения';
|
||
5..1000: Result := n + ' значений';
|
||
end;
|
||
end;
|
||
|
||
procedure RobotCheckSolution;
|
||
begin
|
||
TaskResult := BadSolution;
|
||
var t := System.Type.GetType('RobotField.RobotField');
|
||
if t<>nil then
|
||
begin
|
||
TaskResultInfo := 'Robot';
|
||
var f := t.GetField('RobField',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static);
|
||
var IsSol := f.FieldType.GetMethod('IsSolution');
|
||
var bool := IsSol.Invoke(f.GetValue(nil),nil);
|
||
if boolean(bool) then
|
||
TaskResult := Solved;
|
||
// RobField.TaskName
|
||
var RBTaskNameInfo := f.FieldType.GetField('TaskName');
|
||
var v := string(RBTaskNameInfo.GetValue(f.GetValue(nil)));
|
||
// Добавлять RB к имени задания если его там нет
|
||
if not v.ToLower.StartsWith('rb') then
|
||
v := v.Insert(0,'RB');
|
||
TaskName := v;
|
||
end;
|
||
end;
|
||
|
||
procedure DrawmanCheckSolution;
|
||
begin
|
||
TaskResult := BadSolution;
|
||
var t := System.Type.GetType('DrawManField.DrawManField');
|
||
if t<>nil then
|
||
begin
|
||
TaskResultInfo := 'Drawman';
|
||
var f := t.GetField('DMField',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static);
|
||
var IsSol := f.FieldType.GetMethod('IsSolution');
|
||
var bool := IsSol.Invoke(f.GetValue(nil),nil);
|
||
if boolean(bool) then
|
||
TaskResult := Solved;
|
||
// DMField.TaskName
|
||
var DMTaskNameInfo := f.FieldType.GetField('TaskName');
|
||
var v := string(DMTaskNameInfo.GetValue(f.GetValue(nil)));
|
||
// Добавлять DM к имени задания если его там нет
|
||
if not v.ToLower.StartsWith('dm') then
|
||
v := v.Insert(0,'DM');
|
||
TaskName := v;
|
||
end;
|
||
end;
|
||
|
||
// Вызов PT4.PT4.__FinalizeModule__ отражением
|
||
procedure PT4CheckSolution;
|
||
begin
|
||
var t := System.Type.GetType('PT4.PT4');
|
||
if t<>nil then
|
||
begin
|
||
var meth := t.GetMethod('__FinalizeModule__',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static);
|
||
if meth <> nil then
|
||
meth.Invoke(nil,nil);
|
||
//
|
||
var f := t.GetField('TaskName',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static);
|
||
TaskName := string(f.GetValue(nil));
|
||
end;
|
||
end;
|
||
|
||
// Вызов PT4.PT4.GetSolutionInfo отражением
|
||
function GetSolutionInfoPT4: string;
|
||
begin
|
||
var t := System.Type.GetType('PT4.PT4');
|
||
if t<>nil then
|
||
begin
|
||
var meth := t.GetMethod('GetSolutionInfo',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static);
|
||
if meth <> nil then
|
||
Result := string(meth.Invoke(nil,nil))
|
||
else Result := '';
|
||
end;
|
||
end;
|
||
|
||
procedure CalcPT4Result(info: string; var TaskResult: TaskStatus; var TaskResultInfo: string);
|
||
// info - строка, возвращаемая GetSolutionInfoPT4
|
||
|
||
function HasSubstr(s_ru, s_en: string): boolean;
|
||
begin
|
||
result := false;
|
||
if Pos(s_ru, info) > 0 then
|
||
result := true
|
||
else if Pos(s_en, info) > 0 then
|
||
result := true
|
||
end;
|
||
|
||
function TypeNamePT(s: string): string;
|
||
begin
|
||
result := '';
|
||
case s of
|
||
'логического типа', 'of logical type':
|
||
result := 'boolean';
|
||
'целого типа', 'of integer type':
|
||
result := 'integer';
|
||
'вещественного типа', 'of real-number type':
|
||
result := 'real';
|
||
'символьного типа', 'of character type':
|
||
result := 'char';
|
||
'строкового типа', 'of string type':
|
||
result := 'string';
|
||
end;
|
||
if result = '' then
|
||
if s.startswith('типа') then
|
||
result := copy(s, 6, 100)
|
||
else if s.startswith('of') then
|
||
begin
|
||
delete(s, 1, 3);
|
||
delete(s, length(s) - 4, 100);
|
||
result := s;
|
||
end;
|
||
end;
|
||
|
||
procedure ExtractParts(var p1, p2, p3: string);
|
||
begin
|
||
var m := Regex.Match(info, 'Для ввода (.*)-го элемента \((.*)\) использована переменная (.*).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[1].Value;
|
||
p2 := TypeNamePT(m.Groups[2].Value);
|
||
p3 := TypeNamePT(m.Groups[3].Value);
|
||
exit;
|
||
end;
|
||
m := Regex.Match(info, 'A variable (.*) is used for input of data item with the order number (.*) \((.*)\).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[2].Value;
|
||
p2 := TypeNamePT(m.Groups[3].Value);
|
||
p3 := TypeNamePT(m.Groups[1].Value);
|
||
exit;
|
||
end;
|
||
|
||
m := Regex.Match(info, 'Для вывода (.*)-го элемента \((.*)\) использовано выражение (.*).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[1].Value;
|
||
p2 := TypeNamePT(m.Groups[2].Value);
|
||
p3 := TypeNamePT(m.Groups[3].Value);
|
||
exit;
|
||
end;
|
||
m := Regex.Match(info, 'An expression (.*) is used for output of data item with the order number (.*) \((.*)\).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[2].Value;
|
||
p2 := TypeNamePT(m.Groups[3].Value);
|
||
p3 := TypeNamePT(m.Groups[1].Value);
|
||
exit;
|
||
end;
|
||
|
||
m := Regex.Match(info, 'Количество выведенных данных: (.*) \(из (.*)\).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[1].Value;
|
||
p2 := m.Groups[2].Value;
|
||
p3 := '';
|
||
exit;
|
||
end;
|
||
m := Regex.Match(info, 'The program has output (.*) data item\(s\) \(the amount of the required items is (.*)\).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[1].Value;
|
||
p2 := m.Groups[2].Value;
|
||
p3 := '';
|
||
exit;
|
||
end;
|
||
|
||
m := Regex.Match(info, 'Количество прочитанных данных: (.*) \(из (.*)\).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[1].Value;
|
||
p2 := m.Groups[2].Value;
|
||
p3 := '';
|
||
exit;
|
||
end;
|
||
m := Regex.Match(info, 'The program has used (.*) input data item\(s\) \(the amount of the required items is (.*)\).');
|
||
if m.Success then
|
||
begin
|
||
p1 := m.Groups[1].Value;
|
||
p2 := m.Groups[2].Value;
|
||
p3 := '';
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
// Если мы сюда зашли, то TaskResult уже под контролем. Но она и так должна быть TaskStatus.InitialTaskPT4
|
||
TaskResult := TaskStatus.InitialTaskPT4;
|
||
TaskResultInfo := 'PT4';
|
||
var p1, p2, p3: string;
|
||
if info = '' then
|
||
exit;
|
||
if HasSubstr('Задание выполнено', 'The task is solved') then
|
||
//ColoredMessage('Задание выполнено', MsgColorGreen)
|
||
TaskResult := TaskStatus.Solved
|
||
else if HasSubstr('Ошибочное решение', 'Wrong solution') then
|
||
//ColoredMessage('Неверное решение')
|
||
TaskResult := TaskStatus.BadSolution
|
||
else if HasSubstr('Неверно указан тип при выводе результатов', 'Invalid type is used for an output data item') then
|
||
begin
|
||
ExtractParts(p1, p2, p3);
|
||
TaskResult := TaskStatus.IOError;
|
||
TaskResultInfo := $'OutputType({p1},{p2},{p3})';
|
||
//ColoredMessage($'Ошибка вывода. При выводе {p1}-го элемента типа {p2} выведено значение типа {p3}');
|
||
end
|
||
else if HasSubstr('Выведены не все результирующие данные', 'Some data are not output') then
|
||
begin
|
||
ExtractParts(p1, p2, p3);
|
||
TaskResult := TaskStatus.IOError;
|
||
TaskResultInfo := $'OutputCount({p1},{p2})';
|
||
//ColoredMessage($'Выведено {p1}, а требуется вывести {p2}', MsgColorOrange);
|
||
end
|
||
else if HasSubstr('Неверно указан тип при вводе исходных данных', 'Invalid type is used for an input data item') then
|
||
begin
|
||
ExtractParts(p1, p2, p3);
|
||
TaskResult := TaskStatus.IOError;
|
||
TaskResultInfo := $'InputType({p1},{p2},{p3})';
|
||
//ColoredMessage($'Ошибка ввода. При вводе {p1}-го элемента типа {p2} использована переменная типа {p3}');
|
||
end
|
||
else if HasSubstr('Введены не все требуемые исходные данные', 'Some required data are not input.') then
|
||
begin
|
||
ExtractParts(p1, p2, p3);
|
||
TaskResult := TaskStatus.IOError;
|
||
TaskResultInfo := $'InputCount({p1},{p2})';
|
||
//ColoredMessage($'Введено {p1}, а требуется ввести {p2}', MsgColorOrange);
|
||
end
|
||
else if HasSubstr('Запуск с правильным вводом данных', 'Correct data input') then
|
||
begin
|
||
TaskResult := TaskStatus.PartialSolution;
|
||
//ColoredMessage('Запуск с правильным вводом данных', MsgColorGray)
|
||
end;
|
||
{else
|
||
ColoredMessage('PT4: '+info.Replace(#13#10, ' ').TrimStart().TrimEnd('.',' '));}
|
||
end;
|
||
|
||
function ConvertTaskName(tn: string): string;
|
||
begin
|
||
var TName := tn;
|
||
// Если есть номер с подчеркиванием в начале, то отбросить его
|
||
var ind := TName.IndexOf('_');
|
||
if (ind >= 0) and TName[1].IsDigit then // Значит, в начале - номер, он служит лишь для упорядочения файлов
|
||
TName := TName.Remove(0,ind + 1);
|
||
if TName.ToLower in TaskNamesMap then
|
||
TName := TaskNamesMap[TName.ToLower];
|
||
Result := TName;
|
||
end;
|
||
|
||
|
||
procedure CheckMyPT;
|
||
begin
|
||
if CheckTask = nil then
|
||
exit;
|
||
var TName := TaskName;
|
||
try
|
||
TName := ConvertTaskName(TaskName);
|
||
|
||
CheckTask(TName);
|
||
// Если это задача из задачника, то результат будет NotUnderControl. И дальше необходимо это преобразовывать
|
||
case TaskResult of
|
||
Solved: ColoredMessage('Задание выполнено', MsgColorGreen);
|
||
BadSolution: ColoredMessage('Неверное решение');
|
||
InitialTask: ;
|
||
BadInitialTask: ColoredMessage('Вы удалили часть кода - восстановите его!', MsgColorMagenta);
|
||
end;
|
||
except
|
||
on e: OutputTypeException do
|
||
begin
|
||
//Writeln(#10+$'Неверно указан тип при выводе данных');
|
||
ColoredMessage($'Ошибка вывода. При выводе {e.n}-го элемента типа {e.ExpectedType} выведено значение типа {e.ActualType}');
|
||
end;
|
||
on e: OutputCountException do
|
||
begin
|
||
if e.Count = 0 then
|
||
ColoredMessage($'Требуется вывести {NValues(e.n)}', MsgColorGray)
|
||
else ColoredMessage($'Выведено {NValues(e.Count)}, а требуется вывести {e.n}', MsgColorOrange);
|
||
end;
|
||
on e: OutputCount2Exception do
|
||
begin
|
||
if e.Count = 0 then
|
||
ColoredMessage($'Требуется вывести по крайней мере {NValues(e.i)}', MsgColorGray)
|
||
else ColoredMessage($'Выведено {NValues(e.Count)}, а требуется вывести по крайней мере {e.i}', MsgColorOrange);
|
||
end;
|
||
on e: InputTypeException do
|
||
begin
|
||
//Writeln(#10+$'Неверно указан тип при вводе исходных данных');
|
||
ColoredMessage($'Ошибка ввода. При вводе {e.n}-го элемента типа {e.ExpectedType} использована переменная типа {e.ActualType}');
|
||
end;
|
||
on e: InputCountException do
|
||
begin
|
||
if e.Count = 0 then
|
||
ColoredMessage($'Требуется ввести {NValues(e.n)}', MsgColorGray)
|
||
else if e.n <> 0 then
|
||
ColoredMessage($'Введено {NValues(e.Count)}, а требуется ввести {e.n}', MsgColorOrange)
|
||
else ColoredMessage($'Введено {NValues(e.Count)}, хотя ничего вводить не требуется', MsgColorOrange);
|
||
end;
|
||
on e: InputCount2Exception do
|
||
begin
|
||
if e.Count = 0 then
|
||
ColoredMessage($'Требуется ввести по крайней мере {NValues(e.i)}', MsgColorGray)
|
||
else ColoredMessage($'Введено {NValues(e.Count)}, а требуется ввести по крайней мере {e.i}', MsgColorOrange);
|
||
end;
|
||
end;
|
||
// Для задачника надо вызывать процедуру __FinalizeModule__ из модуля PT4 jnhf;tybtv, а в модуле PT4 эту процедуру тогда не вызывть
|
||
// Для задачника в CheckTaskPT надо сказать, что проверяется задача из задачника. И выводить на экран ничего не надо - только в базу.
|
||
TaskResultInfo := TaskException.Info;
|
||
|
||
var TaskPlatform := 'LT';
|
||
|
||
// Теперь тщательно проверяем задачник и исполнителей
|
||
if IsPT then
|
||
begin
|
||
PT4CheckSolution;
|
||
TName := TaskName;
|
||
var info := GetSolutionInfoPT4;
|
||
CalcPT4Result(info,TaskResult,TaskResultInfo);
|
||
TaskPlatform := 'PT';
|
||
end
|
||
else if IsRobot then
|
||
begin
|
||
RobotCheckSolution;
|
||
TName := TaskName;
|
||
TaskPlatform := 'RB';
|
||
end
|
||
else if IsDrawman then
|
||
begin
|
||
DrawmanCheckSolution;
|
||
TName := TaskName;
|
||
TaskPlatform := 'DM';
|
||
end;
|
||
// Хотелось бы писать в БД для Робота и др. имя задания в Task
|
||
if WriteInfoCallBack<>nil then
|
||
WriteInfoCallBack(LessonName,TName,TaskPlatform,TaskResult,TaskResultInfo);
|
||
end;
|
||
|
||
procedure WriteInfoToRemoteDatabase(auth: string; LessonName, TaskName, TaskPlatform, TaskResult, AdditionalInfo: string);
|
||
begin
|
||
// Считать логин пароль из auth
|
||
var data := System.IO.File.ReadAllBytes(auth);
|
||
var arr := Decrypt(data).Split(#10);
|
||
var login,pass: string;
|
||
if arr.Length >= 2 then
|
||
begin
|
||
login := arr[0];
|
||
pass := arr[1];
|
||
// Теперь как-то записать в БД информацию
|
||
var User := new ServerAccessProvider(ServerAddr);
|
||
var t2 := User.SendPostRequest(login, pass, LessonName, TaskName, TaskPlatform, TaskResult, AdditionalInfo);
|
||
var v := t2.Result;
|
||
//Console.WriteLine(v);
|
||
end;
|
||
end;
|
||
|
||
procedure WriteInfoToDatabases(LessonName,TaskName,TaskPlatform: string; TaskResult: TaskStatus; AdditionalInfo: string := '');
|
||
begin
|
||
try
|
||
System.IO.File.AppendAllText('db.txt', $'{LessonName} {TaskName} {dateTime.Now.ToString(''u'')} {TaskResult.ToString} {AdditionalInfo}' + #10);
|
||
var auth := FindAuthDat();
|
||
var args := System.Environment.GetCommandLineArgs;
|
||
if (auth <> '') and (args.Length = 3) and (args[2].ToLower = 'true') then
|
||
// Есть проблема паузы при плохой сети
|
||
WriteInfoToRemoteDatabase(auth,LessonName,TaskName,TaskPlatform,TaskResult.ToString, AdditionalInfo);
|
||
except
|
||
on e: System.AggregateException do
|
||
begin
|
||
foreach var x in e.InnerExceptions do
|
||
if x is HTTPRequestException then
|
||
ColoredMessage(x.InnerException?.Message??'',MsgColorGray)
|
||
else ColoredMessage(x.Message,MsgColorGray);
|
||
end;
|
||
on e: Exception do
|
||
ColoredMessage(e.Message,MsgColorGray);
|
||
end;
|
||
end;
|
||
|
||
procedure LoadLightPTInfo;
|
||
begin
|
||
try
|
||
var lines := ReadAllLines(lightptname);
|
||
foreach var line in lines do
|
||
begin
|
||
if line.Trim = '' then
|
||
continue;
|
||
if LessonName = '' then
|
||
LessonName := line.ToWords.First // первое слово
|
||
else begin
|
||
var (name1,name2) := Regex.Split(line,'->');
|
||
TaskNamesMap[name1.Trim.ToLower] := name2.Trim;
|
||
end;
|
||
end;
|
||
if LessonName = '' then
|
||
begin
|
||
// Имя текущей папки. Плохо - в lightpt забыли написать имя урока
|
||
//var ttt := ExtractFileDir(System.Environment.GetCommandLineArgs[0]);
|
||
var ttt := ExpandFileName('.');
|
||
var LastDir := ttt.ToWords(System.IO.Path.DirectorySeparatorChar).LastOrDefault;
|
||
// Каталог может содержать пробелы. Брать первое слово
|
||
if LastDir<>nil then
|
||
LessonName := LastDir.ToWords.First;
|
||
end;
|
||
except
|
||
|
||
end;
|
||
end;
|
||
|
||
initialization
|
||
// Если LightPT добавляется в конец uses, то ее секция инициализации вызывается первой
|
||
// В этом случае ввод-вывод обязательно переключается, но потом он перекрывается и в основной программе не срабатывает
|
||
// Но в CheckPT используется ColoredMessage, которая выводит с помощью Console.WriteLine - ей всё равно
|
||
var tn := TypeName(CurrentIOSystem);
|
||
if (tn = 'IOStandardSystem') or (tn = '__ReadSignalOISystem') or (tn = 'IOGraphABCSystem') then
|
||
CurrentIOSystem := new IOLightSystem;
|
||
WriteInfoCallBack := WriteInfoToDatabases;
|
||
// Расшифровка LightPT.dat
|
||
LoadLightPTInfo;
|
||
finalization
|
||
CheckMyPT
|
||
end. |