Типизированные файлы, очень старая и побитая тема...

[maliyusha]

Задача:
Создать файл из одномерных целочисленных массивов a1,a2,...,a10, заполненных числами от
–50 до 50. Переписать в другой типизированный файл те массивы, у которых сумма элементов >0.

Вот решение задачи:
 

Код:

Uses crt;
const
  N=10;
type
  TArray=array[1..N] of shortint;{celo4islennye s korotkim diapazonom}
var
  Buf:TArray;
  F1,F2:file of TArray;
  A:string;
procedure FillArray(var A:TArray);
var i:integer;
begin
  clrscr;
  randomize;
  for i:=1 to N do A[i]:=random(101)-50;
end;
procedure PrintArray(A:TArray; Before,After:string);
var i:integer;
begin
  writeln(Before);
  for i:=1 to N-1 do write(A[i],'; ');
  writeln(A[N],'. ',After);
end;
function AskYN(Question:string; defaultYes:boolean):boolean;
var
  Answer:string;
begin
  repeat
    writeln(Question,' (Da/Net):');
    if defaultYes then write('[Da]') else writeln('Net');
    readln(Answer);
  until (Answer='') or (Answer[1] in ['D','d','N','n']);
  if Answer=''
    then AskYN:=defaultYes
    else AskYN:=Answer[1] in ['D','d'];
end;
function Sum(A:TArray):longint;
 var i:integer;S:longint;
  begin
    S:=A[1]; for i:=2 to N do S:=S+A[i];
    Sum:=S;
  end;
  var S:longint;
begin
     writeln('    Sozdanie faila file1.dat');
     assign(F1,'file1.dat');
     rewrite(F1); {otkrivaem fail dlya zapisi}
      repeat
       FillArray(Buf);
       write(F1,Buf);
       PrintArray(Buf,'Massiv: ','zapisan v fail file1.dat');
      until AskYN('Dobavit esche massiv?',false)=false;
    close(F1);
  writeln('Perepisyvanie massivov v fail file2.dat');
  reset(F1);
  assign(F2,'file2.dat');
  rewrite(F2);
  while not eof(F1) do
   begin
    read(F1,Buf);
    S:=Sum(Buf);
    write('Summa ',S,'.');
    read;
      if S>0 then
       begin
        write(F2,Buf);
        PrintArray(Buf,'Massiv: ','zapisan v fail file2.dat'); readln;
       end else
       begin
        PrintArray(Buf,'Massiv: ','propuschen');readln;
       end;
   end;
  close(F1);
  close(F2);
end.

Проблема в том,что она выводит и те массивы сумма которых меньше нуля  ,как это исправить? Подскажите,пожалуйста. И еще, по-моему, я тут слишком много лишнего понапихала... 

[maliyusha]

 Всё  , спасибо строгому учителю   

Вот правильный вариант решения задачи

Код:

Uses crt;
type TA=array[1..10] of integer;
var
i,j,k,S: integer;
a, Sum: TA;
F1,F2: file of TA;
begin
 clrscr;
 writeln('    Sozdanie faila file1.doc');
 assign(F1,'file1.doc'); {svyazyvaet vneshnii fail s failovoi peremennoi}
 assign(F2,'file2.doc');
 rewrite(F1);{sozdaet i otkryvaet novyi fail}
 randomize;
 for j:=1 to 10 do
    begin
     for i:=1 to 10 do a[i]:=random(101)-50;
     write(F1,a);{zapisat zna4enie a v fail F1 }
     for i:=1 to 10 do
     write(a[i]:3,' '); {vyvod na ekran}
     writeln;
    end;
 readln;
 close(F1);
 reset(F1);{otkryvaet fail dlya 4teniya}
 {2 aya 4ast programmy}
 writeln('Perepisyvanie massivov v fail file2.doc');
 rewrite(F2); {sozdaet i otkryvaet novyi fail}
 for i:=1 to 10 do
   begin
    read(F1,a);
     begin
      S:=0;
      for j:=1 to 10 do S:=S+a[j];
      if S>0 then
       begin
        write('Summa=',S:3,'; ');
        for k:=1 to 10 do
        write(a[k]:3, ' ');
        writeln;
        write(F2,a);
       end;
     end;
   end;
 close(F2);
 close(F1);
 readln;
end.