удаление из файла строки min длины, и модуль обработки последовательности символов Опции

[Лысый]

1.Пусть дан текстовый файл. Удалите из этого файла строку минимальной длины.

2.Написать модуль, содержащий две процедуры: 1) пусть вводится последовательность не более 10 символов, признаком конца ввода служит точка. Определите сколько прописных букв латинского алфавита входит в эту последовательность; 2) Замените каждый элемент массива средним арифметическим всех предшествующих ему элементов.

Помогите па-па-па-п-пожалуйста.

Сообщение отредактировано: мисс_граффити - 13.06.2007 10:06

[Altair]

>>>Пусть дан текстовый файл. Удалите из этого файла строку минимальной длины.
Вот решение

Код

Var
 f,ff:text;
 i:word;
 fn,s:string;
 maxst:byte;
 nm:word;
 nmin:word;
begin
 maxst:=255;
 Writeln('File name ');
 Readln(s);
 Assign(f,s); Reset(f);
 While not EOF(f) do
 begin
  inc(nm);
  readln(f,fn);
  If ORD(s[0])<Maxst then
  begin
   maxst:=ord(s[0]);
   nmin:=nm;
  end;
 end;
 nm:=0;
 Close(f);
 {теперь строка минимальная имеет номер nmin}
 Assign(ff,'temp.dat');
 Reset(f);
 rewrite(ff);
 while not eof(f) do
 begin
  inc(nm);
  readln(f,fn);
  If nm<>nmin then writeln(ff,fn);
 end;
 Close(f);
 Close(ff);
 Erase(f);
 rename(ff,s);
End.

>>>Написать модуль, содержащий две процедуры:
>>>1) пусть вводится
>>>последовательность не более 10 символов, признаком конца ввода служит точка.
>>>oпределите сколько прописных букв латинского алфавита входит в эту
>>>последовательность;
>>>2) Замените каждый элемент массива средним арифметическим всех предшествующих
>>>ему элементов.

Код

Unit test;
INTERFACE
const
maxk=15;
Type
massivType=array[1..maxk] of integer;
procedure 1(var b:byte);
procedure 2(var b:massivType; kolelmas:integer);
IMPLEMENTATION
uses crt;
procedure 1;
var
 c:byte;
 s:string;
 max:byte;
begin
 s:='';
 repeat
  c:=ORD(readkey);
  s:=s+CHR(c)
 until c=46;
 For c:=1 to ord(s[0]) do If (ord(s[c])>64) and (ORD(s[0])<91) then inc(max);
 b:=max;
end;
Procedure 2(var b:massivType; kolelmas:integer);
var
 i,k:integer;
 sum,sa:Integer;
begin
 for i:=1 to kolelmas do
 begin
  for k:=1 to i-1 do sum:=sum+b[k];
  sa:=rtunc(sum/k);
  b[i]:=sa;
 end
end;
Begin
End.

Фотка просто бомба!!

Автопортрет.