Динамически считать Данные из файла, и вывести результат в файл

[StudeHt]

Здравствуйте уважаемые эксперты. Помогите решить следующую задачу:Удалить лишние пробелы в тексте. Данные считать из файла, и вывести результат в файл Поискав по форуму нашел, похожую тему, но мне нужно чтобы память выделялась динамически.. В общем вот мой код:

{$R-}
type TMas=array[1..1] of string;
     PMas=^TMas;

procedure OpenFile(NameFile:string; var FileIn:text);
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка! Файл ',NameFile,' не найден!');
      readln;
      halt;
    end;
end;

procedure ReadCountOfStringFromFile(var FileIn:text; var S:string; var n:longint);
begin
  n:=0;
  while not Eof(FileIn) do
    begin
      readln(FileIn,S);
      inc(n);
    end;
end;

procedure ReadFileInDinamicMas(var FileIn:text; var a:PMas);
var i:integer;
begin
  i:=0;
  while not Eof(FileIn) do
    begin
      inc(i);
      readln(FileIn,a^[i]);
    end;
    Close(FileIn);
end;

procedure InputData(a:PMas; S:string; var n:longint);
var FileIn:text;
    NameFile:string;
begin
  OpenFile(NameFile,FileIn);
  ReadCountOfStringFromFile(FileIn,S,n);
  GetMem(a,SizeOf(string)*n);
  ReadFileInDinamicMas(FileIn,a);
end;

procedure DeleteSpacesInString(var S:string);
var p,i:integer;
begin
  for i:=1 to length(S) do
    begin
      repeat
        p:=Pos('  ',S);
        if p>0 then Delete(S,p,1);
      until p=0;
    end;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
end;

procedure DeleteSpacesInMas(n:longint; var a:PMas);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;

procedure OutputData(a:PMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  for i:=1 to n do
    writeln(FileOut,a^[i]);
    FreeMem(a,SizeOf(string)*n);
    Close(FileOut);
end;

var a:PMas;
    n:longint;
    S:string;
begin
  InputData(n,S,a);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

В выходной файл выводится какие то непонятные "корявины". Помогите пожалуйста, не знаю в чем ошибка... Заранее огромное спасибо

[Sazary]

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

{$R-}
type TMas=array[1..1] of string;
     PMas=^TMas;

procedure OpenFile(var NameFile:string; var FileIn:text);
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка! Файл ',NameFile,' не найден!');
      readln;
      halt;
    end;
end;

procedure ReadCountOfStringFromFile(var FileIn:text; var S:string; var n:longint);
begin
  n:=0;
  while not Eof(FileIn) do
    begin
      readln(FileIn,S);
      inc(n);
    end;
close(FileIn);
reset(FileIn);
end;

procedure ReadFileInDinamicMas(var FileIn:text; var a:PMas);
var i:integer;
begin
  i:=0;
  while not Eof(FileIn) do
    begin
      inc(i);
      readln(FileIn,a^[i]);
    end;
    Close(FileIn);
end;

procedure InputData(var a:PMas; var S:string; var n:longint);
var FileIn:text;
    NameFile:string;
begin
  OpenFile(NameFile,FileIn);
  ReadCountOfStringFromFile(FileIn,S,n);
  GetMem(a,SizeOf(string)*n);
  ReadFileInDinamicMas(FileIn,a);
end;

procedure DeleteSpacesInString(var S:string);
var p,i:integer;
begin
  for i:=1 to length(S) do
    begin
      repeat
        p:=Pos('  ',S);
        if p>0 then Delete(S,p,1);
      until p=0;
    end;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
end;

procedure DeleteSpacesInMas(n:longint; var a:PMas);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;

procedure OutputData(a:PMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  for i:=1 to n do
    writeln(FileOut,a^[i]);
    FreeMem(a,SizeOf(string)*n);
    Close(FileOut);
end;

var a:PMas;
    n:longint;
    S:string;
begin
  InputData(a,S,n);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

[StudeHt]

Спасибо Вам огромное Sazary! Вы очень выручили!!!

[cu2zoff]

Присоединяюсь к вышесказаному! Спасибо, я почти это же хотел спросить)))