Показать сообщение отдельно
Старый 14.04.2013, 17:52   #1 (permalink)
777Студент777
Новичок
 
Регистрация: 14.04.2013
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Exclamation Помогите дописать программу. Не сложно

Программа создает список студентов. записывает их в файл. может вывести на экран. короче она вся работает только нужно добавить функции добавить и удалить нужного студента из списка и все. Помогите пожалуйста.желательно кинуть сюда сообщение с готовым кодом. заранее спс вот собственно сам код.





program laba_spiski;
uses
CRT;

type aaa = ^student;
Student=record
kurs,name:string[100];
vozr:integer;
next:aaa;
prev:aaa;
end;
var ps,pn,pt, pserch :aaa;
n,i, kommand :integer;

//----------------------------------------------------------------------
Procedure Init_List;
label m1;
var i,r:integer; F:text; m:string;
Begin

writeln(' Здравствуйте!');
writeln('Данная программа создает список студентов');
m1:
writeln('Создать новый список или загрузить из файла?');
writeln('для создания нового введите 1 ');
writeln('для загрузки из файла введите 2');
readln(r);
if (r<>1) and (r<>2) then goto m1;

if (r=1)
then begin
writeln('Укажите число студентов в группе');readln(n);
end
else begin
writeln('Введи имя файла из которого нужно загрузить список');
write('Имя файла:'); readln(m);
assign(F, m);
reset(F);
readln(F, n);
end;

ps:=nil; pt:=nil; pn:=nil;

for i:=1 to n do
begin new(pn);
if (ps=nil) then begin ps:=pn;
pn^.next:=nil;
pn^.prev:=nil;
end
else begin pt^.next:=pn;
pn^.prev:=pt;
pn^.next:=nil;
end;

if (r=1)
then begin writeln('Введите',i,'-ого студетна');
write('ФИО-'); readln(pn^.name);
write('Факультет-'); readln(pn^.kurs);
end
else begin readln(F, pn^.name);
readln(F, pn^.kurs);
end;

pt:=pn;
end;

if (r=2) then close(F);
End;


//---------------------------------------------------------------
Procedure Print_List;
var i : integer;
Begin

i:=1;
writeln('Список группы');
pt:=ps;
while(pt<>nil) do begin
writeln(i, 'ФИО-->', pt^.name,' Факультет-->',pt^.kurs);
pt:=pt^.next;
I:=I+1;
end;
End;

//-------------------------------------------------------------------
Function Get_Command : integer;
label m2;
var f : integer;
Begin
m2:
writeln;
writeln('--------------------------------------------------------');
writeln('для добавления - введите 1 ');
writeln('для удаления --- введите 2');
writeln('для поиска ----- введите 3');
writeln('для печати списка ------- введите 4 ');
writeln('для выхода из программы - введите 5');

readln(f);
if (f<1) or (f>5) then goto m2;

writeln;
writeln;

Get_Command := f;
End;

//---------------------------------------------------------------
Procedure Save_File;
var F:text; s:string;
Begin
writeln();
writeln('Все результаты программы будут записываться в файл, при указания имени файла укажите формат');
write('имя нового файла:'); readln(s);

assign(F, s);
rewrite(F);
writeln(F,n);
pt:=ps;
while(pt<>nil) do begin
writeln(F,pt^.name);
writeln(F,pt^.kurs);
pt:=pt^.next;
end;
close(f);
End;

//-------------------------------------------------------------------
Procedure Ochistka;
Begin
while (pt<>nil) do begin
ps:=pt^.next;
dispose(pt);
pt:=ps;
end;
End;

//-------------------------------------------------------------------
procedure Poisk;
var name:string[100];
Begin
writeln('Введите ФИО стедента которого необходимо найти в списке');
readln(name);
pt:=ps;
pserch:=nil;

while(pt<>nil) do begin
if name=pt^.name
then begin pserch:=pt;
pt:=nil;
end
else pt:=pt^.next;
end;

if pserch=nil then writeln('Такого(-ю) студента(-ку) не найдено')
else begin writeln('ФИО-',pserch^.name);
writeln('Факультет-',pserch^.kurs);
end;
end;

//-------------------------------------------------------------------
label m3;

begin
Init_List;

m3:
Kommand:=Get_Command;

case Kommand of
1: Begin
end;
2: Begin
end;
3: Begin Poisk;
end;
4: Begin Print_List;
end;
5: Begin Save_File;
Ochistka;
exit;
end;
end;
goto m3;

end.
777Студент777 вне форума   Ответить с цитированием
Ads

Яндекс

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