uses CRT;
CONST
base_FileName = '177809.dat';
addres_len = 30; {Длина строки адреса}
TYPE
TOneRoom = record
space_main, space_living, space_kitchen: Real;
loggia: Boolean;
level, levels: Byte; {этаж, количество этажей}
addres: String[addres_len];
cost : Real;
end;
CONST
qf_space_main : Word = $0001;
qf_space_living : Word = $0002;
qf_space_kitchen: Word = $0004;
qf_level : Word = $0008; {Задан этаж}
qf_levels : Word = $0010;
qf_cost : Word = $0011;
TYPE
TQuery = record
query_fileds: Longint; {биты определяют, какие поля
в требовании определены}
{В следующих полях 0 означает - не лимитируется}
space_main_min, space_main_max: Real;
space_living_min, space_living_main_max: Real;
space_kitchen_min, space_kitchen_max: Real;
level_min, level_max, levels_min, level_max: Byte;
cost_min, cost_max: Real;
loggia: Boolen; {либо требуется, либо нет}
end;
CONST
base_FileName = '177809.dat';
street_len = 15; {Длина строки адреса}
TYPE
TAddres = record
Street: String[street_len];
house: Integer;
room : Integer;
end;
TOneRoom = record
space_main, space_living, space_kitchen: Real;
loggia : Boolean;
tel : Boolean;
Internet: Boolean;
level, levels: Integer; {этаж, количество этажей}
addres: TAddres;
cost : Real;
end;
TQuery = record
{В следующих полях 0 означает - не лимитируется
если не 0, то соответствующая минимальная и/или максимальная величина
Смысл полей очевиден}
space_main_min, space_main_max: Real;
space_living_min, space_living_main_max: Real;
space_kitchen_min, space_kitchen_max: Real;
level_min, level_max, levels_min, levels_max: Byte;
cost_min, cost_max: Real;
loggia: Boolean; {либо требуется, либо нет}
end;
procedure PrintOne(r: TOneRoom);
{Печать информации об одной квартире}
begin
WriteLn('Улица:',r.addres.Street:street_len,
'. Дом: ', r.addres.house:4,
'. Квартира: ',r.addres.room:4);
WriteLn('Площадь общая: ',r.space_main:8:2,
', жилая: ',r.space_living:8:2,
', кухня : ',r.space_kitchen:8:2);
WriteLn('Этаж: ',r.level:4, ', этажей: ',r.levels:4);
Write('Лоджия: ');
if r.loggia then Write('есть') else Write('нет');
Write(', тел: '); if r.tel then Write('есть') else Write('нет');
Write(', Интернет: '); if r.Internet then WriteLn('есть') else WriteLn('нет');
Write(' стоимость: ');WriteLn(r.cost: 12:2)
end;
function PrintAll(aFileName: String): int64;
{Вывод всей информации. Возвращает число записей в файле}
var
f: File of TOneRoom;
r: TOneRoom;
count: int64;
begin
if NOT FileExists(aFileName) then begin
WriteLn('Не могу открыть файл базы данных ', aFileName);
PrintAll := -1;
Exit;
end
else
begin
Assign(f, aFileName);
Reset(f);
if FileSize(f) = 0 then
begin
WriteLn('Файл ',aFileName,' пуст');
PrintAll := 0;
Exit
end;
count := 0;
While not eof(f) do
begin
inc(count); Write(count:3,') ');
Read(f, r);
PrintOne(r);
WriteLn;
end;
end;
Close(f);
PrintAll := count
end;
function PutRoom(aFileName: String): Integer;
{Сохраняет в файле (не в массиве!!) информацию о квартирах
возвращает количество информационных записей
если не ввести ни одной - то можно узнать, сколько имеется
в базе данных}
function Info(var t: TOneRoom): Boolean;
{Ввод информации об одной квартире. TRUE, если поля заполнены
и тогда нужно запоминать в файл}
var s: String;
begin
repeat
WriteLn('Ввод информации об одной квартире:');
Write('Введите улицу (если просто нажмете ENTER - ввод завершится): ');
ReadLn(s);
result := s <> '';
if NOT result then Exit; {Немедленный выход из подпрограммы}
// полагаю, что отрицательные числа вводить не будет
// а потому проверку эту пропускаю
t.addres.Street := Copy(s, 1, street_len); {Может ввести больше}
repeat
Write('Введите номер дома (целое число): '); ReadLn(s)
until tryStrToInt(s, t.addres.house);
repeat
Write('Введите номер квартиры (целое число): '); ReadLn(s)
until tryStrToInt(s, t.addres.room);
repeat
Write('Введите площадь кухни (вещественное число): '); ReadLn(s);
until tryStrToFloat(s, t.space_kitchen);
repeat
Write('Введите жилую площадь площадь : '); ReadLn(s);
until tryStrToFloat(s, t.space_living);
repeat
repeat
Write('Введите общую площадь: '); ReadLn(s);
until tryStrToFloat(s, t.space_main);
until (t.space_main > t.space_living + t.space_kitchen);
// Общая площадь не должна быть меньше или равна сумме
repeat
Write('Количество этажей в доме: '); ReadLn(s)
until tryStrToInt(s, t.levels);
repeat
repeat
Write('Введите этаж, на котором расположена квартира: '); ReadLn(s);
until tryStrToInt(s, t.level)
until (t.level <= t.levels);
Write('Имеется ли лоджия? Если "Да" - просто нажмите ENTER, иначе - любые символы и ENTER');
ReadLn(s);
t.loggia := s = '';
Write('Проведен ли телефон? Если "Да" - просто нажмите ENTER, иначе - любые символы и ENTER');
ReadLn(s);
t.tel := s = '';
Write('Подключен ли Интернет? Если "Да" - просто нажмите ENTER, иначе - любые символы и ENTER');
ReadLn(s);
t.Internet := s = '';
repeat
Write('Введите стоимость квартиры: '); ReadLn(s);
until tryStrToFloat(s, t.cost);
WriteLn;
WriteLn('Вы ввели:');
PrintOne(t);
Write('Если информация правильная, нажмите ENTER, иначе - любые символы и ENTER'); ReadLn(s);
result := s = '';
WriteLn;
until result;
end;
var
f: File of TOneRoom;
r: TOneRoom;
count, c: int64;
s: String;
begin
count := 0;
Assign(f, aFileName);
if FileExists(aFileName) then
begin
Reset(f);
c := (FileSize(f));
if c > 0 then
begin
WriteLn('Файл ', AFileName,' существует. Количество записей в нем: ',c,'. Переписать?');
WriteLn(' Если "ДА" (при этом прежняя информация будет уничтожена),');
WriteLn(' то введите любые символы и нажмите ENTER');
WriteLn(' Иначе (сохранить информацию), просто нажмите ENTER');
ReadLn(s);
if length(s) = 0 then
Reset(f)
else
Rewrite(f);
end
end
else Rewrite(f);
seek(f, FileSize(f));
while Info(r) do begin
Write(f, r);
inc(count)
end;
Close(f);
PutRoom := count;
end;
(*
function FindRoom(aFileName: String): int64;
{возвращает количество квартир в файле базы данных
или -1, если ничего не найдено}
var
f: File of TOneRoom;
//r: TOneRoom;
//p: int64;
//q: TQuery;
count: int64;
function FindTheRoom(From: Longint): LongInt;
{Локальная функция - ищет одну квартиру в базе данных
начиная с записи с данным номером (начинается с нуля).
Контролирует выход за пределы файла
возвращает положение записи в файле данных
или -1, если ничего не найдено}
begin
FindTheRoom := -1;
end;
function aQuery: Boolean;
{формирование запроса. FALSE - если отказался от запроса}
begin
aQuery := FALSE;
end;
begin
count := 0;
if NOT FileExists(aFileName) then begin
WriteLn('Не могу открыть файл базы данных ', aFileName);
FindRoom := -1;
Exit;
end;
FindRoom := count;
Close(f);
end;
*)
procedure Menu;
var s: String;
f: File of TOneRoom;
c: int64;
begin
if FileExists(base_fileName) then
begin
Assign(f, base_fileName);
Reset(f);
c := FileSize(f);
CloseFile(f);
if c > 0 then
begin
WriteLn('Файл ',base_fileName,' существует. Количество записей в нем: ',c,'');
end
else
begin
WriteLn('Файл базы данных пуст. Необходимо ввести информацию');
PutRoom(base_fileName)
end;
end
else
begin
WriteLn('Отсутствует файл базы данных. Необходимо ввести информацию');
PutRoom(base_fileName)
end;
repeat
WriteLn('Меню: (для выбора нажмите клавишу и ENTER)');
WriteLn(' 1 - ввод информации');
WriteLn(' 2 - просмотр имеющейся информации');
WriteLn(' 3 - поиск по критерию');
WriteLn(' Если хотите завершить работу, наберите Exit и нажите ENTER');
ReadLn(s);
s := UpperCase(s);
if s.StartsWith('E') then Exit;
if s.StartsWith('1') then PutRoom(base_fileName)
else
if s.StartsWith('2') then PrintAll(base_fileName);
until s = 'exit';
end;
BEGIN
Menu;
WriteLn('Работа программы завершена');
END.
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.