Оформить в процедуры

[Сеня2007]

Вот исходный текст программы:

 uses crt;
type
    type_rec=record
    fio:string[15];
    nazvanie:string[20];
    god:word;
end;
 
var
   f_in,f_out:text;
   spis:array[1..1000] of type_rec;
   y:type_rec;
   kol_zap,i:word;
   zap:type_rec;
   key:byte;
   j,f:integer;
 
BEGIN
clrscr;
     assign(f_in,'text.dan');
     reset (f_in);
     i:=0;
     while not Eof(f_in) do
     begin inc(i);
     with spis[i] do
     readln(f_in,fio,nazvanie,god);
     end;
     kol_zap:=i;
writeln('Zapisey:=',kol_zap);
writeln;
 
for i:=1 to kol_zap do
with spis[i] do
begin
writeln(fio:15,nazvanie:20,god);
end;
writeln;
readkey;
 
for i:=1 to kol_zap do
with spis[i] do
if (spis[i].god<1985) then
begin
write(fio:15,nazvanie:20,god);
writeln;
end;
f:=kol_zap;
readkey;
 
repeat
key:=0;
for i:=1 to f do
with spis[i] do
if spis[i].god<spis[i+1].god then
begin
y:=spis[i];
spis[i]:=spis[i+1];
spis[i+1]:=y;
key:=1;
end;
until key=0;
readkey;
 
    i:=0;
writeln;
while i<= f do
begin
i:=i+1;
if pos('Ivanov',spis[i].fio)>0 then
begin
if i=f then dec(f)
else
 begin
for j:=i to f-1 do
spis[j]:=spis[j+1];
dec(i); dec(f);
 end;
end;
end;
 
 
writeln('del massiv');
for i:=1 to f do
with spis[i] do
begin
write(fio:15,nazvanie:20,god);
writeln;
end;
 
assign(f_out,'sor.dan');
rewrite(f_out);
for i:=1 to f do
with spis[i] do
begin
writeln(f_out,fio:15,nazvanie:20,god);
end;
close(f_in); close(f_out);
readkey;
END.

Вот что я сделал:

uses crt;
type
    type_rec=record
    fio:string[15];
    nazvanie:string[20];
    god:word;
end;
 
var
   spis:array[1..1000] of type_rec;
   f_in,f_out:text;
   y:type_rec;
   kol_zap,i:word;
   j,f:integer;
 
 
Procedure vvod(spis:type_rec);
Begin
     assign(f_in,'text.dan');
     reset (f_in);
     i:=0;
     while not Eof(f_in) do
     begin inc(i);
     with spis[i] do
     readln(f_in,fio,nazvanie,god);
     end;
     kol_zap:=i;
End;
 
writeln('Zapisey:=',kol_zap);
writeln;
 
Procedure vivod1(spis[i]:array of type_rec);
Begin
for i:=1 to kol_zap do
with spis[i] do
begin
writeln(fio:15,nazvanie:20,god);
end;
writeln;
readkey;
End;
 
Procedure poisk(spis[i]:array of type_rec,f:word);
Begin
for i:=1 to kol_zap do
with spis[i] do
if (spis[i].god<1985) then
begin
write(fio:15,nazvanie:20,god);
writeln;
end;
f:=kol_zap;
readkey;
End;
 
Procedure sortidel(spis[i]:array of type_rec,f:word);
var
   key:byte;
   y:type_rec;
Begin
repeat
key:=0;
for i:=1 to f do
with spis[i] do
if spis[i].god<spis[i+1].god then
begin
y:=spis[i];
spis[i]:=spis[i+1];
spis[i+1]:=y;
key:=1;
end;
until key=0;
 
 
    i:=0;
writeln;
while i<= f do
begin
i:=i+1;
if pos('Ivanov',spis[i].fio)>0 then
begin
if i=f then dec(f)
else
 begin
for j:=i to f-1 do
spis[j]:=spis[j+1];
dec(i); dec(f);
 end;
end;
end;
 
 
writeln('del massiv');
for i:=1 to f do
with spis[i] do
begin
write(fio:15,nazvanie:20,god);
writeln;
end;
End;
 
Procedure soxr(spis[i]:array of type_rec,f:word);
Begin
assign(f_out,'sor.dan');
rewrite(f_out);
for i:=1 to f do
with spis[i] do
begin
writeln(f_out,fio:15,nazvanie:20,god);
end;
End;
 
BEGIN
Clrscr;
    vvod(spis[i]);
    vivod1(spis[i],f);
    poisk(spis[i],f);
    sortidel(spis[i],f);
    soxr(spis[i],f);
 
close(f_in); close(f_out);
readkey;
END.

Ошибок куча, разобраться не в состоянии. Выручайте!!

[Serebro]

To Сеня2007:
так нельзя делать!
Что за текст программы? Что сделано? Зачем? и так далее...
Неужели кому-то будет интересно самому разбираться в подобных вопросах?

[Sibedir]

program Project1;

{$APPTYPE CONSOLE}

type
  TRec = record
    fio:string[15];
    nazvanie:string[20];
    god:word;
  end;

  TSpis = array[1..1000] of TRec;

function vvod (AFileName: String; var ASpis: TSpis): Word;
var
  f: text;
begin
  AssignFile (f, AFileName);
  Reset (f);
  Result := 0;
  while not Eof(f) do begin
    Inc (Result);
    with ASpis[Result] do
      Readln (f, fio, nazvanie, god);
  end;
  CloseFile (f);
end;

procedure vivod (spis: TSpis; N: Word);
var
  i: Integer;
begin
  for i := 1 to N do
    with spis[i] do
      Writeln (fio:15, nazvanie:20, god);
end;

function poisk (ASpis: TSpis; N: Word; AGod: word): Word;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to N do
    with ASpis[i] do
      if god < AGod then begin
        Writeln (fio:15, nazvanie:20, god);
        Inc (Result);
      end;
end;

procedure sortidel (var ASpis: TSpis; var N: Word; ADelFIO: String);
var
  i, j: Integer;
  key: Byte;
  y: TRec;
begin
  i := 1;
  while i <= N do
    if Pos (ADelFIO, ASpis[i].fio) = 0 then
      Inc(i)
    else begin
      if i < N then begin
        for j := i to N-1 do
          ASpis[j] := ASpis[j+1];
      end;
      Dec(N)
    end;

  repeat
    key := 0;
    for i := 1 to N-1 do
      if ASpis[i].god < ASpis[i+1].god then begin
        y := ASpis[i];
        ASpis[i] := ASpis[i+1];
        ASpis[i+1] := y;
        key:=1;
      end;
  until key = 0;
end;

procedure soxr (FileName: String; ASpis: TSpis; N: Word);
var
  f: text;
  i: Integer;
begin
  AssignFile (f, FileName);
  Rewrite (f);
  for i := 1 to N do
    with ASpis[i] do
      Writeln (f, fio:15, nazvanie:20, god);
  CloseFile (f);
end;

var
  spis: TSpis;
  kol_zap, i: Word;

begin
  kol_zap := vvod ('text.dan', spis);

  Writeln;
  Writeln ('Spisok:');
  vivod (spis, kol_zap);
  Writeln ('Zapisey = ', kol_zap);
  Readln;

  Writeln;
  Writeln ('Spisok (god < 1985):');
  i := poisk (spis, kol_zap, 1985);
  Writeln ('Zapisey = ', i);
  Readln;

  sortidel (spis, kol_zap, 'Ivanov');
  Writeln;
  Writeln ('Sortirovanniy spisok (bez Ivanov):');
  vivod (spis, kol_zap);
  Readln;

  soxr('sor.dan', spis, kol_zap);
  Writeln;
  Writeln ('Spisok sohranen');

  Readln;
END.

end.

Это консоль на Delphi, потому есть нюансы по синтаксису. Например вместо Assign - AssignFile

РАЗБИРАЙСЯ

Неужели кому-то будет интересно самому разбираться в подобных вопросах?

Да тут впринципе все как два пальца

[Сеня2007]

А вам нечего знать и ненадо. Исходный код есть, поученный тоже. Нужно только исправить ошибки в образовании процедур. Я могу канешно скинуть еще задание, но зачем если программа и так работает, а процедуры умеющему расплюнуть сделать!

Так что надо изменить кроме assignfile не подскажите?

[Sibedir]

а процедуры умеющему расплюнуть сделать

С учетом объема кода - харкнуть

Так что надо изменить кроме assignfile не подскажите?

Компилятор сам подскажет

[Stilet]

А вам нечего знать и ненадо

Согласен. Зачем нам это?