динамика, работа с файлами

[world12_tk]

Здраствуйте!
Не могли бы вы мне помочь.... Мне нужно было написать программу, которая печатает самое длинное слово, найденное в тексте файла, с помощью динамического массива....
Вот исходный код
Код:

program dlin;
type
  arrays=array[0..0] of string;
  file_text=^arrays;
procedure InputFiles( var buffer_of_text:file_text; var size:longint);
var
  filename:string;
  fin:file of char;
begin
  writeln('Введите имя файла: ');
  readln(filename);
  assign(fin,filename); {процедура связывания файла fin  с именем filename }
  {$I-}
    reset(fin);  {открытие файла}
  {$I+}
  if IOResult <> 0 then    {завершение программы}
  begin
    writeln('Файл не найден.');
    readln;
    halt;    {выход из программы}
  end;
  size:=FileSize(fin);
  Getmem(buffer_of_text,size);
end;

procedure ReadFile(size:longint; var fin:text; var buffer_of_text:file_text);
var
  ch : char;
  i:longint;
begin

  while not eof(fin) do  {пока не конец файла}
  for i:=1 to size do
  begin
    read(fin,ch);
    if ch=#13 then        {если ch возвращает каретку на начало, то}
      buffer_of_text[i]^:=buffer_of_text[i]^ + ' '
    else
      if ch=#10 then    {если перевод строки,то выход из условия}
        continue
      else
        buffer_of_text[i]^:= buffer_of_text[i]^ + ch;
  end;
  close(fin); {закрытие файла}
end;

procedure FindTheLongestWord( size:longist; var buffer_of_text:file_text; var longest_word:string);
var
  word:string;
  count_symbols:integer;
  i:longint;
  max_count_symbols:integer;
begin
  count_symbols:= 0;
  word := '';
  max_count_symbols := 0;
  for i:=1 to size do
    if buffer_of_text[i]^<>' ' then
    begin
      count_symbols:=count_symbols+1;
      word:=word+buffer_of_text[i]^;
    end
    else
      begin
        if count_symbols>max_count_symbols then
        begin
          max_count_symbols:=count_symbols;
          longest_word:=word;
        end;
        count_symbols:=0;
        word:='';
      end;
end;


procedure OutputWord (longest_word:string);
begin
    writeln('Самое длинное слово в тексте: ',longest_word);
    readln;
end;
var
  longest_word:string;
  fin : text;
  buffer_of_text:file_text;
  size:longint;

begin
  InputFiles(buffer_of_text,size);
  ReadFile(size,fin,buffer_of_text);
  FindTheLongestWord(size,buffer_of_text,longest_word);
  OutputWord (longest_word);
end.

Я не могу ни как исправить ошибку.... Помогите мне.....
Заранее спасибо...

[Stilet]

Жесть...
Могу предложить вот так наполнять динмассив:

var f:file of char; a:array of char;i:integer;s,k:string;
begin
 assignfile(f,'file1.txt');reset(f);
 setlength(a,FileSize(f));
 blockRead(f,a[1],length(a));
readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.

Потом уж в нем и ищи самое длинное слово

[Serge_Bliznykov]

Виталий, зря Вы так. Код практически рабочий.
чуть-чуть напильничком прошёлся..
Кстати, это код под TurboPascal, там по другому не получится работать с "безразмерными" динамическими массивами! А Ваш код под Delphi...

world12_tk
вот рабочий код (в принципе, в основе полностью Ваш код! чтение и поиск слова я вообще не менял ничего!):

program dlin;
type
  arrays=array[0..0] of string;
  file_text=^arrays;

procedure InputFiles( var buffer_of_text:file_text; var size:longint; var fin:text);
var
  filename:string;
  fin_Temp : file of char;
begin
  writeln('Введите имя файла: ');
  readln(filename);
  assign(fin_Temp,filename); {процедура связывания файла fin_Temp  с именем filename }
  {$I-}
    reset(fin_Temp);  {открытие файла}
  {$I+}
  if IOResult <> 0 then    {завершение программы}
  begin
    writeln('Файл '+filename+' не найден.');
    readln;
    halt;    {выход из программы}
  end;
  size:=FileSize(fin_Temp);
  Getmem(buffer_of_text,size);
  Close(fin_Temp);

  assign(fin,filename); {процедура связывания файла fin  с именем filename }
  reset(fin);  {открытие файла}

end;

procedure ReadFile(size:longint; var buffer_of_text:file_text; var fin:Text);
var
  ch : char;
  i:longint;
begin

  while not eof(fin) do  {пока не конец файла}
  for i:=1 to size do
  begin
    read(fin,ch);
    if ch=#13 then        {если ch возвращает каретку на начало, то}
      buffer_of_text^[i]:=buffer_of_text^[i] + ' '
    else
      if ch=#10 then    {если перевод строки,то выход из условия}
        continue
      else
        buffer_of_text^[i]:= buffer_of_text^[i] + ch;
  end;
  close(fin); {закрытие файла}
end;

procedure FindTheLongestWord( size:longint; var buffer_of_text:file_text; var longest_word:string);
var
  word:string;
  count_symbols:integer;
  i:longint;
  max_count_symbols:integer;
begin
  count_symbols:= 0;
  word := '';
  max_count_symbols := 0;
  for i:=1 to size do
    if buffer_of_text^[i]<>' ' then
    begin
      count_symbols:=count_symbols+1;
      word:=word+buffer_of_text^[i];
    end
    else
      begin
        if count_symbols>max_count_symbols then
        begin
          max_count_symbols:=count_symbols;
          longest_word:=word;
        end;
        count_symbols:=0;
        word:='';
      end;
end;


procedure OutputWord (longest_word:string);
begin
    writeln('Самое длинное слово в тексте: ',longest_word);
    readln;
end;

procedure Free_Array_Memory(size:longint; var buffer_of_text:file_text);
begin
  FreeMem(buffer_of_text,size);
  buffer_of_text := nil;
end;

var
  longest_word:string;
  fin : Text;
  buffer_of_text:file_text;
  size:longint;

begin
  InputFiles(buffer_of_text,size, fin);
  ReadFile(size,buffer_of_text, fin);
  FindTheLongestWord(size,buffer_of_text,longest_word);
  Free_Array_Memory(size,buffer_of_text);
  OutputWord (longest_word);
end.

[Stilet]

Серж, я не против, я это говорил о самой стратегии.
Уж очень неоптимально автор считывает в массив из файла.

Кстати, это код под TurboPascal

Я для примера, не очень то там много и менять чтоб в ТР заработало.

[danekne]

Ммм... а кто такие условия ставит? Давно ли паскаль умеет работать с динамическими массивами? Там жеж вроде только связанные списки есть, насколько я помню

[Stilet]

Давно ли паскаль умеет работать с динамическими массивами?

Начиная с 7-й версии.

[world12_tk]

такие задания дают нам преподы.... они нас очень любят..
Спасибо за прогу.... она компилируется, но теперь выдает пустые значения длинного слова.... Посмотрел отладчиком... Я так понял в массив записываються пустые символы.....
Вы не могли бы мне помочь исправить ее

[Serge_Bliznykov]

блиин.. действительно.. а я ведь тестировал...

ладно. проблема тут:

type
  arrays=array[0..0] of char;

так же, рекомендую заменить процедуру чтения на:

procedure ReadFile(var buffer_of_text:file_text; var fin:Text);
var
  ch : char;
  i:longint;
begin
  i:=0;
  while not eof(fin) do  {пока не конец файла}
  begin
    read(fin,ch);
    if (ch=#13) or (ch=#10)  then   {если ch возвращает каретку на начало, то}
      buffer_of_text^[i]:=' '
    else
      buffer_of_text^[i]:= ch;
    inc(i);
  end;
  close(fin); {закрытие файла}
end;