Удаление лишних пробелов. Динамическая память

@S2dent · Регистрация: 10.05.2009

Студворк — интернет-сервис помощи студентам

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

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
{$R-}
program lab16;
type Mas=array[1..1] of string;
     DinMas=^Mas;
 
procedure InputData(var a:DinMas; var n:integer);
var FileIn:text;
    NameFile:string;
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  GetMem(a,SizeOf(string)*n);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка! Файл ',NameFile,' не найден!');
      readln;
      halt;
    end;
    n:=0;
    while not Eof(FileIn) do
      begin
        inc(n);
        readln(FileIn,a^[n]);
      end;
      Close(FileIn);
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;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
    end;
end;
 
procedure DeleteSpacesInMas(var a:DinMas; n:integer);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;
 
procedure OutputData(a:DinMas; 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:DinMas;
    n:integer;
begin
  InputData(a,n);
  DeleteSpacesInMas(a,n);
  OutputData(a,n);
end.

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

@Puporev · 10.05.2009, 13:02

Перед

Pascal
1
2
3
4
5
6
7
n:=0;
    while not Eof(FileIn) do
      begin
        inc(n);
        readln(FileIn,a^[n]);
      end;
      Close(FileIn);

нужно написать new(a)-выделить память под масив.
а после этого

Pascal
1
2
3
4
5
6
7
8
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);

написать dispose(a)- освободить память.

@S2dent · 10.05.2009, 18:47 **[ТС]**

И снова проблема с этой задачей. Препод сказал, что в программе нужно использовать функции GetMem и FreeMem. Дал указание что данные из файла нужно считывать дважды. Вот мои очередные попытки:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
{$R-}
program lab16;
type Mas=array[1..1] of string;
     DinMas=^Mas;
 
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 ReadFile(var n:integer; var FileIn:text);
var NameFile:string;
begin
  OpenFile(NameFile,FileIn);
  n:=0;
  while not Eof(FileIn) do
    begin
      inc(n);
      readln(FileIn,n);
    end;
end;
 
procedure InputData(var a:DinMas; n:integer);
var FileIn:text;
    NameFile:string;
begin
  ReadFile(n,FileIn);
  GetMem(a,SizeOf(string)*n);
    n:=0;
    while not Eof(FileIn) do
      begin
        inc(n);
        readln(FileIn,a^[n]);
      end;
      Close(FileIn);
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;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
    end;
end;
 
procedure DeleteSpacesInMas(var a:DinMas; n:integer);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;
 
procedure OutputData(a:DinMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  FreeMem(a,SizeOf(string)*n);
  rewrite(FileOut);
  for i:=1 to n do
    writeln(FileOut,a^[i]);
    Close(FileOut);
end;
 
var a:DinMas;
    n:integer;
begin
  InputData(a,n);
  DeleteSpacesInMas(a,n);
  OutputData(a,n);
end.

Но на 30 строчке выскакивает ошибка 106(Invalid numeric format) Помогите пожалуйста исправить ошибку.

@Puporev · 10.05.2009, 18:57

Вот что тытут пытаешься делать?

Pascal
1
2
3
4
5
6
7
8
9
10
11
procedure ReadFile(var n:integer; var FileIn:text);
var NameFile:string;
begin
  OpenFile(NameFile,FileIn);
  n:=0;
  while not Eof(FileIn) do
    begin
      inc(n);
      readln(FileIn,n);//файл текстовый, процедурой readln читают только строки
    end;                  //а n-целое число. Если хочешь прочитать это число, то надо
end;                    //read(FileIn,n);

@S2dent · 10.05.2009, 19:02 **[ТС]**

Вот что тытут пытаешься делать?

В процедуре ReadFile я пытаюсь считать количество строк в файле, чтобы в следующей процедуре выделить память под это число строк. Исправил readln на read ошибка все равно осталась..

@Puporev · 10.05.2009, 19:08

Количество строк у Вас=n, которое Вы посчитали. Зачем Вы пытаетесь прочитать его из файла, если его там нет? Уберите вообще readln(FileIn,n);

@S2dent · 10.05.2009, 19:12 **[ТС]**

Уберите вообще readln(FileIn,n);

В таком случае будет бесконечный цикл..

@Puporev · 10.05.2009, 19:16

Pascal
1
2
3
4
5
6
7
8
9
10
11
procedure ReadFile(var n:integer; var FileIn:text);
var NameFile:string;
begin
  OpenFile(NameFile,FileIn);
  n:=0;//количество строк=0
  while not Eof(FileIn) do
    begin
      readln(FileIn,s);//читаем строку, s:string;
      inc(n);//считаем-это и есть количество строк
    end;                  
end;

@S2dent · 10.05.2009, 19:23 **[ТС]**

Спасибо Puporev!!! Но теперь к сожалению выходной файл остается пустым, помогите пожалуйста доделать эту программу.

@Puporev · 10.05.2009, 20:02

Попробуй в состав параметров открытия файла и вывода в файл включить переменные файла и их имени(убрав их разделов var подпрограмм), а то вроде эти процедуры никакого отношения к файлам не имеют и никак данные из файла в программу и из программы в файл не передают.

@S2dent · 10.05.2009, 20:14 **[ТС]**

Попробуй в состав параметров открытия файла и вывода в файл включить переменные файла и их имени(убрав их разделов var подпрограмм), а то вроде эти процедуры никакого отношения к файлам не имеют и никак данные из файла в программу и из программы в файл не передают.

Ну я вот так это вижу:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
{$R-}
program lab16;
type Mas=array[1..1] of string; 
     DinMas=^Mas;
 
procedure OpenFile(var FileIn:text);
var NameFile:string;
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка! Файл ',NameFile,' не найден!');
      readln;
      halt;
    end;
end;
 
procedure ReadFile(var n:integer; var S:string; var FileIn:text);
var NameFile:string;
begin
  OpenFile(FileIn);
  n:=0;
  while not Eof(FileIn) do
    begin
      readln(FileIn,S);
      inc(n);
    end;
end;
 
procedure InputData(n:integer; var a:DinMas; var S:string);
var FileIn:text;
    NameFile:string;
begin
  ReadFile(n,S,FileIn);
  GetMem(a,SizeOf(string)*n);
  n:=0;
  while not Eof(FileIn) do
    begin
      inc(n);
      readln(FileIn,a^[n]);
    end;
      Close(FileIn);
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;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
    end;
end;
 
procedure DeleteSpacesInMas(n:integer; var a:DinMas);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;
 
procedure OutputData(a:DinMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  FreeMem(a,SizeOf(string)*n);
  rewrite(FileOut);
  for i:=1 to n do
    writeln(FileOut,a^[i]);
    Close(FileOut);
end;
 
var a:DinMas;
    n:integer;
    S:string;
begin
  InputData(n,a,S);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

Если вносить параметры FileIn, FileOut, NameFile в список фактических параметров процедур, то препод не примет, т.к. он сказал, что процедура обработки не должна иметь ни какого отношения к файлу, для этого я считывал данные в массив..

@S2dent · 16.05.2009, 17:05 **[ТС]**

Господа эксперты вновь прошу помощи с решением этой задачи.. Ни как не удается понять в чем ошибка.. Попытки внести переменные NameFile,FileIn в список фактических параметров успехов не дали.. (Извините что поздно отписываюсь, инет был отключен..((() Вот выкладываю код, но он не сильно отличается от предыдущего поста

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
{$R-}
program lab16;
type Mas=array[1..1] of string;
     DinMas=^Mas;
 
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 ReadFile(S,NameFile:string; var n:integer; var FileIn:text);
begin
  OpenFile(NameFile,FileIn);
  n:=0;
  while not Eof(FileIn) do
    begin
      readln(FileIn,S);
      inc(n);
    end;
end;
 
procedure InputData(S:string; n:integer; var a:DinMas);
var FileIn:text;
    NameFile:string;
begin
  ReadFile(S,NameFile,n,FileIn);
  GetMem(a,SizeOf(string)*n);
  n:=0;
  while not Eof(FileIn) do
    begin
      inc(n);
      readln(FileIn,a^[n]);
    end;
      Close(FileIn);
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;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
    end;
end;
 
procedure DeleteSpacesInMas(n:integer; var a:DinMas);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;
 
procedure OutputData(a:DinMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  FreeMem(a,SizeOf(string)*n);
  rewrite(FileOut);
  for i:=1 to n do
    writeln(FileOut,a^[i]);
    Close(FileOut);
end;
 
var a:DinMas;
    n:integer;
    S:string;
begin
  InputData(S,n,a);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

@MiniMin · 16.05.2009, 19:51

Вы в функции ReadFile считываете данные "в никуда". переменная S у вас является локальным аргументом. поэтому она мало того что переписывается несклько раз (каждые 255 символов), она ещё и разрушается при выходе из процедуры. А т.к. вы в дальнейшем используете тот же дескриптор входного файла, он у вас остается на прошлом смещении. Т.е. в конце файла. А значит вы фактически в процедуре InputData при открытии файла сразу перемещаете указатель в конец не прочитав ни байта.

Добавлено через 1 минуту 44 секунды
Вобщем замените в InputData вызов ReadFile на OpenFile

Добавлено через 1 минуту 25 секунд
и вообще вы вроде как запутались с String и ^Mas )))))

@S2dent · 16.05.2009, 20:17 **[ТС]**

Спасибо Вам MiniMin! Но честно говоря не совсем Вас понял..

Вы в функции ReadFile считываете данные "в никуда". переменная S у вас является локальным аргументом. поэтому она мало того что переписывается несклько раз (каждые 255 символов), она ещё и разрушается при выходе из процедуры. А т.к. вы в дальнейшем используете тот же дескриптор входного файла, он у вас остается на прошлом смещении. Т.е. в конце файла. А значит вы фактически в процедуре InputData при открытии файла сразу перемещаете указатель в конец не прочитав ни байта.
Вобщем замените в InputData вызов ReadFile на OpenFile

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

и вообще вы вроде как запутались с String и ^Mas )))))

А это я совсем не понимаю, где я запутался.. В общем выкладываю код с поправками которые понял..

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
{$R-}
program lab16;
type Mas=array[1..1] of string;
     DinMas=^Mas;
 
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 ReadFile(NameFile:string; var S:string; var n:integer; var FileIn:text);
begin
  OpenFile(NameFile,FileIn);
  n:=0;
  while not Eof(FileIn) do
    begin
      readln(FileIn,S);
      inc(n);
    end;
end;
 
procedure InputData(S:string; n:integer; var a:DinMas);
var FileIn:text;
    NameFile:string;
begin
  OpenFile(NameFile,FileIn);
  GetMem(a,SizeOf(string)*n);
  n:=0;
  while not Eof(FileIn) do
    begin
      inc(n);
      readln(FileIn,a^[n]);
    end;
      Close(FileIn);
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;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
    end;
end;
 
procedure DeleteSpacesInMas(n:integer; var a:DinMas);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;
 
procedure OutputData(a:DinMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  FreeMem(a,SizeOf(string)*n);
  rewrite(FileOut);
  for i:=1 to n do
    writeln(FileOut,a^[i]);
    Close(FileOut);
end;
 
var a:DinMas;
    n:integer;
    S,NameFile:string;
    FileIn:text;
begin
  ReadFile(NameFile,S,n,FileIn);
  InputData(S,n,a);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

P.S. программа стала работать, но не совсем корректно.. Удаляет пробелы в последней строке файла.. Вы попытались объяснить, но я не понял как это исправить.. Помогите пожалуйста..

@MiniMin · 16.05.2009, 20:26

такой вариант не подойдёт?

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
type
element=record
 value:char;
 next:^element;
end;
 
mass=record
 first:^element;
 ends:^element;
 current:^element;
end;
 
procedure createMass(var m:mass;ch:char);
var NewElement:^element;
begin
 new(NewElement);
 NewElement^.value:=ch;
 NewElement^.next:=nil;
 m.first:=NewElement;
 m.ends:=NewElement;
 m.current:=NewElement;
end;
 
procedure add(var m:mass;ch:char);
var NewElement:^element;
begin
 new(NewElement);
 NewElement^.value:=ch;
 NewElement^.next:=nil;
 m.ends^.next:=NewElement;
 m.ends:=NewElement;
end;
 
procedure delNext(var m:mass);
var TempElement:^element;
begin
 TempElement:=m.current^.next;
 m.current^.next:=m.current^.next^.next;
 dispose(TempElement);
end;
 
procedure goNext(var m:mass);
begin
 m.current:=m.current^.next;
end;
 
procedure DelSpaces(var m:mass);
var space:boolean;
begin
 space:=(m.current^.value=' ');
 if m.current^.next<>nil then
  repeat
  if m.current^.next^.value=' ' then
   begin
    if space then delNext(m)
    else goNext(m);
   space:=true;
   end
   else
    begin
     space:=false;
     goNext(m);
    end;
  until m.current^.next=nil
end;
 
procedure InputData(var m:mass);
var fileName:string;
    fIn:text;
    ch:char;
begin
 writeln('Input Name of Input File:');
 readln(fileName);
 assign(fIn,fileName);
 {$I-}
 reset(fIn);
 {I+}
 if (IOResult<>0) then
  begin
   writeln('Error! File not exist');
   readln;
   halt;
  end;
 if eof(fIn) then
  begin
   writeln('File ',fileName,' is empty.');
   readln;
   halt;
  end;
 read(fIn,ch);
 createMass(m,ch);
 while not eof(fIn) do
  begin
   read(fIn,ch);
   add(m,ch);
  end;
 Close(fIn);
end;
 
procedure OutputData(var m:mass);
var fileName:string;
    fOut:text;
begin
 writeln('Input Name of Output File:');
 readln(fileName);
 assign(fOut,fileName);
 rewrite(fOut);
 m.current:=m.first;
 while m.current^.next<>nil do
  begin
   write(fOut,m.current^.value);
   goNext(m);
  end;
 write(fOut,m.current^.value);
 close(fOut);
end;
 
var m:mass;
begin
 InputData(m);
 DelSpaces(m);
 OutputData(m);
end.

@S2dent · 16.05.2009, 20:33 **[ТС]**

такой вариант не подойдёт?

К сожалению не подойдет.. Препод сказал, что нужно память выделять динамически с помощью функций GetMem и очищать ее с помощью FreeMem. С функцией new не подходит, да к тому же, мне уже Puporev предлагал решение данной задачи через нее.. Препод ее отверг(((.. Да и все таки хотелось бы на основе своей программы..

@MiniMin · 16.05.2009, 21:41

через строки тут лучше не делать.... ведь ещё придется проверять пробелы на "стыках" строк..... и размеры все просчитывать.....

Добавлено через 1 минуту 51 секунду
сейчас попробую подкорректить вашу прогу....

Добавлено через 42 минуты 3 секунды
вот))))

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
type Mass=array[1..1] of string;
     DinMas=^Mass;
 
procedure OpenFile(var FileIn:text;var n:integer);
var NameFile:string;
    tempF:file of byte;
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(tempF,NameFile);
  {$I-}
  reset(tempF);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка! Файл ',NameFile,' не найден!');
      readln;
      halt;
    end;
  if filesize(tempF) mod 255 > 0 then n:=1;
  n:=n+filesize(tempF) div 255;
  close(tempF);
  assign(FileIn,NameFile);
  reset(FileIn);
end;
 
procedure InputData(var a:DinMas;var n:integer);
var FileIn:text;
    NameFile:string;
    i:longint;
begin
  OpenFile(FileIn,n);
  GetMem(a,n*sizeof(string));
  i:=0;
  while not Eof(FileIn) do
   begin
    inc(i);
    read(FileIn,a^[i]);
   end;
  Close(FileIn);
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;
      if S[1]=' ' then Delete(S,1,1);
        if S[length(S)]=' ' then Delete(S,length(S),1);
    end;
end;
 
procedure DeleteSpacesInMas(n:integer; var a:DinMas);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a^[i]);
end;
 
procedure OutputData(a:DinMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  for i:=1 to n do
    write(FileOut,a^[i]);
    Close(FileOut);
  FreeMem(a,n*sizeof(string));
end;
 
var a:DinMas;
    n:integer;
    S,NameFile:string;
    FileIn:text;
begin
  InputData(a,n);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

Добавлено через 2 минуты 43 секунды
только в DeleteSpacesInString убери for.
Он там ни к чему.

Добавлено через 20 минут 32 секунды
И две процедуры нужно поменять ещё. Для обработки на "стыках" строк.
вот полный код:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
type Mass=array[1..1] of string;
     DinMas=^Mass;
 
procedure OpenFile(var FileIn:text;var n:integer);
var NameFile:string;
    tempF:file of byte;
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(tempF,NameFile);
  {$I-}
  reset(tempF);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка! Файл ',NameFile,' не найден!');
      readln;
      halt;
    end;
  if filesize(tempF) mod 255 > 0 then n:=1;
  n:=n+filesize(tempF) div 255;
  close(tempF);
  assign(FileIn,NameFile);
  reset(FileIn);
end;
 
procedure InputData(var a:DinMas;var n:integer);
var FileIn:text;
    NameFile:string;
    i:longint;
begin
  OpenFile(FileIn,n);
  GetMem(a,n*sizeof(string));
  i:=0;
  while not Eof(FileIn) do
   begin
    inc(i);
    read(FileIn,a^[i]);
   end;
  Close(FileIn);
end;
 
procedure DeleteSpacesInString(var S:string);
var p,i:integer;
begin
 repeat
  p:=Pos('  ',S);
  if p>0 then Delete(S,p,1);
 until p=0;
end;
 
procedure DeleteSpacesInMas(n:integer; var a:DinMas);
var i:integer;
    S:string;
begin
  for i:=1 to n do
   DeleteSpacesInString(a^[i]);
  S:=a^[1];
  if S[1]=' ' then Delete(S,1,1);
  S:=a^[n];
  if S[length(S)]=' ' then Delete(S,length(S),1);
  if n>1 then
   for i:=1 to n-1 do
    begin
     S:=a^[i];
     if (S[length(S)]=' ') and (a^[i+1][1]=' ') then Delete(a^[i+1],1,1);
    end;
end;
 
procedure OutputData(a:DinMas; n:integer);
var FileOut:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  for i:=1 to n do
    write(FileOut,a^[i]);
    Close(FileOut);
  FreeMem(a,n*sizeof(string));
end;
 
var a:DinMas;
    n:integer;
    S,NameFile:string;
    FileIn:text;
begin
  InputData(a,n);
  DeleteSpacesInMas(n,a);
  OutputData(a,n);
end.

@S2dent · 16.05.2009, 21:54 **[ТС]**

Спасибо Вам огромное MiniMin!!! Только не могли бы Вы объяснить процедуру OpenFile Что такое tempF и для чего Вы его используете???

@MiniMin · 16.05.2009, 21:58

tempF это типизированный файл. Дело в том, что функция filesize(f), которая возвращает размер файла есть только у типизированных файлов. Поэтому я этот же файл сначала открываю как типизированный, чтобы узнать размер, который нам необходим для GetMem до ввода в массив. Когда узнал, я его закрыл и открыл этот же файл уже в текстовом режиме.

@S2dent · 16.05.2009, 22:01 **[ТС]**

Спасибо еще раз MiniMin!!! Надо будет почитать теорию про типизированные файлы..)))

Новые блоги и статьи Все статьи Все блоги /
YAFU@home — распределённые вычисления для математики. На CPU Programma_Boinc 20.01.2026 YAFU@home — распределённые вычисления для математики. На CPU YAFU@home — это BOINC-проект, который занимается факторизацией больших чисел и исследованием aliquot-последовательностей. Звучит. . .	http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит: токи, напряжения и их 1 и 2 производные при t = 0;. . .
Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .

@Puporev Почетный модератор 64314 / 47610 / 32743 Регистрация: 18.05.2008 Сообщений: 115,168
	10.05.2009, 19:08
	Количество строк у Вас=n, которое Вы посчитали. Зачем Вы пытаетесь прочитать его из файла, если его там нет? Уберите вообще readln(FileIn,n); 0

@S2dent 55 / 53 / 24 Регистрация: 10.05.2009 Сообщений: 216
	10.05.2009, 19:23 [ТС]
	Спасибо Puporev!!! Но теперь к сожалению выходной файл остается пустым, помогите пожалуйста доделать эту программу. 0

@Puporev Почетный модератор 64314 / 47610 / 32743 Регистрация: 18.05.2008 Сообщений: 115,168
	10.05.2009, 20:02
	Попробуй в состав параметров открытия файла и вывода в файл включить переменные файла и их имени(убрав их разделов var подпрограмм), а то вроде эти процедуры никакого отношения к файлам не имеют и никак данные из файла в программу и из программы в файл не передают. 0

@MiniMin 68 / 24 / 2 Регистрация: 16.05.2009 Сообщений: 73
	16.05.2009, 19:51
	Вы в функции ReadFile считываете данные "в никуда". переменная S у вас является локальным аргументом. поэтому она мало того что переписывается несклько раз (каждые 255 символов), она ещё и разрушается при выходе из процедуры. А т.к. вы в дальнейшем используете тот же дескриптор входного файла, он у вас остается на прошлом смещении. Т.е. в конце файла. А значит вы фактически в процедуре InputData при открытии файла сразу перемещаете указатель в конец не прочитав ни байта. Добавлено через 1 минуту 44 секунды Вобщем замените в InputData вызов ReadFile на OpenFile Добавлено через 1 минуту 25 секунд и вообще вы вроде как запутались с String и ^Mas ))))) 1

@S2dent 55 / 53 / 24 Регистрация: 10.05.2009 Сообщений: 216
	16.05.2009, 21:54 [ТС]
	Спасибо Вам огромное MiniMin!!! Только не могли бы Вы объяснить процедуру OpenFile Что такое tempF и для чего Вы его используете??? 0

@MiniMin 68 / 24 / 2 Регистрация: 16.05.2009 Сообщений: 73
	16.05.2009, 21:58
	tempF это типизированный файл. Дело в том, что функция filesize(f), которая возвращает размер файла есть только у типизированных файлов. Поэтому я этот же файл сначала открываю как типизированный, чтобы узнать размер, который нам необходим для GetMem до ввода в массив. Когда узнал, я его закрыл и открыл этот же файл уже в текстовом режиме. 1

@S2dent 55 / 53 / 24 Регистрация: 10.05.2009 Сообщений: 216
	16.05.2009, 22:01 [ТС]
	Спасибо еще раз MiniMin!!! Надо будет почитать теорию про типизированные файлы..))) 0