Помогите с задачей в Паскале
Используя типы файл, запись и процедура.
В файле содержится информация об итогах сессии. Фамилия Группа Оценка 1 Оценка 2 Оценка 3 Написать программу которая вводит эту информацию и выводит название предмета который был сдан лучше всего. |
Мне пришло на ум только БД на паскале.
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. |
Часовой пояс GMT +4, время: 23:49. |
Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.