Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 29.09.2011, 17:26   #1 (permalink)
Alexander9458
Новичок
 
Регистрация: 08.06.2011
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Exclamation Помогите с задачей в Паскале

Используя типы файл, запись и процедура.
В файле содержится информация об итогах сессии.
Фамилия
Группа
Оценка 1
Оценка 2
Оценка 3
Написать программу которая вводит эту информацию и выводит название предмета который был сдан лучше всего.
Alexander9458 вне форума   Ответить с цитированием

Старый 29.09.2011, 17:26
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Скорее всего проблема уже решена в одном из данных топиков

Помогите пожалуйста с задачей по C++
Помогите с задачей на php-код
Помогите с задачей. Ряд Тейлора.
Пожалуйста, помогите с задачей
Помогите с графической задачей

Старый 30.09.2011, 01:34   #2 (permalink)
Gruvi
VIP user
 
Аватар для Gruvi
 
Регистрация: 10.03.2011
Сообщений: 765
Записей в дневнике: 1
Сказал(а) спасибо: 10
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 3453
По умолчанию

Мне пришло на ум только БД на паскале.

Program BaseData;
uses crt;
label 12;
type
qwerty = record
Name :string;
fam :string;
tel :string;
id :string;
spec :string;
end;
const namebase = 'base.db';
var
fil :file of qwerty;
qwer :qwerty;
otv :char;
poisk:string;
poi :integer;
col :integer;
i,y :integer;
procedure menu;
begin
assign(fil,namebase);
if FileExists(NAMEBASE) then reset(fil)
else rewrite(fil);
writeln('_________________________________________ _________________');
writeln(' 1. Добавить запись');
writeln(' 2. Обзор всех записей');
writeln(' 3. Быстрый поиск');
writeln(' 4. Расширеный поиск');
writeln(' 5. Удалить запись');
writeln(' 6. Изенить заись');
writeln(' 7. Выход');
write('Выбор: ');readln(otv);
end;
procedure menu_search;
begin
writeln('_________________________________________ _________________');
writeln(' 1. по имени');
writeln(' 2. по фамилии');
writeln(' 3. по телефону');
writeln(' 4. по профессии');
write('Выбор: ');
readln(poi);
case poi of
1: begin
seek(fil,0);
writeln('поиск о имени');
readln(poisk);
col:=0;
writeln;
while not(eof(fil)) do
begin
read(fil,qwer);
if qwer.name = poisk then
begin
inc(col);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);
end;
end;
writeln;
writeln(' кол-во записей = ',col);
end;
2: begin
seek(fil,0);
writeln('Поиск по фамилии');
readln(poisk);
col:=0;
writeln;
while not(eof(fil)) do
begin
read(fil,qwer);
if qwer.fam = poisk then
begin
inc(col);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);

end;
end;
writeln;
writeln(' кол-во записей = ',col);
end;
3: begin
seek(fil,0);
writeln('Поиск по номеру телефона');
readln(poisk);
col:=0;
writeln;
while not(eof(fil)) do
begin
read(fil,qwer);
if qwer.tel = poisk then
begin
inc(col);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);

end;
end;
writeln;
writeln(' кол-во записей = ',col);
end;
4: begin
seek(fil,0);
writeln('Поиск по профессии');
readln(poisk);
col:=0;
writeln;
while not(eof(fil)) do
begin
read(fil,qwer);
if qwer.spec = poisk then
begin
inc(col);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);

end;
end;
writeln;
writeln(' кол-во записей = ',col);
end;
5: begin
seek(fil,0);
writeln('Поиск по id номеру');
readln(poisk);
col:=0;
writeln;
while not(eof(fil)) do
begin
read(fil,qwer);
if qwer.id = poisk then
begin
inc(col);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);

end;
end;
writeln;
writeln(' кол-во записей = ',col);
end;
end;
end;
procedure files_add;
begin
seek(fil,filesize(fil));
with qwer do
begin
writeln('***************************************** ************');
writeln('Введите данные новой записи:');
write('имя ');
readln(name);
write('фамилия ');
readln(fam);
write('телефон ');
readln(tel);
writeln('професия');
readln(spec);
writeln('id номер');
readln(id);
writeln('***************************************** ************');
end;
write(fil,qwer);
end;
procedure files_read;

begin
seek(fil,0);
col:=0;
writeln;
writeln(' чтение записи из файла ');
while not(eof(fil)) do
begin
inc(col);
read(fil,qwer);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);

end;
writeln;
writeln(' кол-во записей = ',col);
end;
procedure search;
begin
seek(fil,0);
writeln('Поиск по имени');
readln(poisk);
col:=0;
writeln;
while not(eof(fil)) do
begin
read(fil,qwer);
if qwer.name = poisk then
begin
inc(col);
writeln(col,'. Имя: ',qwer.name,' Фамилия: ',qwer.fam,' Телефон: ',qwer.tel,' Професия: ',qwer.spec,' id номер: ',qwer.id);

end;
end;
writeln;
writeln(' кол-во записей = ',col);
end;

Procedure del_record;
var NumRec:integer;
IOresult: integer;
begin
Assign(fil,namebase);
{$I-}
reset(fil);
{$I }
If IOresult=1 then
begin
writeln('Такого файла данных не существует');
end
else
writeln('Введите номер удаляемой записи');
Read(NumRec);
begin
if NumRec >FileSize(fil) then
begin
writeln('Такой записи не существует');
end
else
begin
Seek(fil,FileSize(fil)-1);
read(fil,qwer);
Seek(Fil,NumRec-1);
write(fil,qwer);
Seek(fil,FileSize(fil)-1);
truncate(fil);
Writeln('Запись стерта');
writeln('Файл данных имеет ',FileSize(fil),' записей');
close(fil);
end;
end;

end;

Procedure Edit_fil;
var
fil :file of qwerty;
qwer :qwerty;
who :string;
found: boolean;
IOresult:integer;
begin
write('Введите фамилию которую вы хотите изменить ');
readln(who);
if who = 'quit' then halt
else
assign(fil,namebase);
{$I-}
reset(Fil);
{$I }
found:=false;
if IOresult=0 then
with qwer do
while Not EOF(Fil) do
begin
read(Fil,qwer);
if fam = who then { нашли такого/ую }
begin
write('Заменить на фамилию: ');
readln(fam);
found:=true;
seek(Fil,FilePos(Fil)-1); { вернуться на 1 позицию обратно, т.е. на позицию того, что надо заменять }
write(fil,qwer);
break; { убрать это, если известно, что таких несколько }
end;
end;
close(fil);
if Not Found
then writeln(Who,' не найден. Ха-ха')
else writeln(Who,' найден и заменен.');
readln;
end;

begin
writeln;
writeln(' ************************************************** *************');
Writeln(' ******************* База данных *****************');
writeln(' ************************************************** *************');

writeln;


12: menu;
clrscr;
case otv of
'1':files_add;
'2':files_read;
'3':search;
'4':menu_search;
'5':del_record;
'6':Edit_fil;
'7':halt;
end;
goto 12;
close(fil);
end.
Gruvi вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 15:09.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.