Alexander, ну вот смотри, видайот ошибку на первом цикле, типа "file not open for input"! Уже всьо перепробовал, файл создал всьо нормально ну вот смотри:
Code
var s:string; f:text; begin assign(f,'z1.dat'); reset(f); while not eof(f) do begin ReadLn(f,s); While Pos('{', s) <> 0 do if Pos('}',s)<>0 then delete(s,Pos('{',s),Pos('}',s)-Pos('}',s)+1) else begin delete(s,Pos('{',s),Length(s)-Pos('{',s)+1); readln(f,s); while Pos('}', s) = 0 do readln(f,s); close(f); delete(s,1,Pos('}', s)); end; assign(f,'z1.sol'); rewrite(f); write(f,s); close(f); end; end.
Чо здесь не так!? Я - желанный гость Сайта взаимопомощи программистам Pascal А ты?
А теперь наоборот выдайот ошибку в конце, типа ""file not open for output"" И што здесь нужно зделать подскажы:
Code
var s:string; f,f1:text; begin assign(f,'z1.dat'); reset(f); assign(f1,'z1.sol'); rewrite(f1); while not eof(f) do begin ReadLn(f,s); While Pos('{', s) <> 0 do if Pos('}',s)<>0 then delete(s,Pos('{',s),Pos('}',s)-Pos('}',s)+1) else begin delete(s,Pos('{',s),Length(s)-Pos('{',s)+1); readln(f,s); while Pos('}', s) = 0 do readln(f,s); close(f); delete(s,1,Pos('}', s)); end; write(f1,s); close(f1); end; end.
Я - желанный гость Сайта взаимопомощи программистам Pascal А ты?
Чото не правильно, ну смотри: я ввожу в файл: var i:integer;{index } a:array[1..10] of real; (*massiv*) begin {rozvjazok zadachi} for i:=1 to 10 do a[i]:=i; {vyvid massiva} for i:=1 to 10 do writeln(a[i]); (*vse*) end. А оно выводит мне: var i:integer;index } a:array[1..10] of real; (*massiv*) for i:=1 to 10 do a[i]:=i; vyvid massiva} for i:=1 to 10 do writeln(a[i]); (*vse*) end. Только всьо в одной строке! Помогите, а! Я - желанный гость Сайта взаимопомощи программистам Pascal А ты?
вот блин, всё равно самому писать... Во-первых функция pos в первый раз вернёт первое вхождение символа, а во второй уже второе, т.е. pos нужно вызывать 1 раз. Во-вторых прежде чем читать новую строчку, надо записать старую.
Code
while not eof(f) do begin ReadLn(f,s); st:=Pos('{',s); While st <> 0 do begin fin:=Pos('}',s); if fin<>0 then delete(s,st,fin-st+1) else begin delete(s,st,Length(s)- fin+1); writeLn(f1,s); readln(f,s); fin:=Pos('}',s); while fin = 0 do begin readln(f,s); fin:=Pos('}',s); end; delete(s,1,fin); end; st:=Pos('{',s); if st<>0 then writeln(f1,s); end; writeln(f1,s); end;
Претензии(просьбы, мольбы о помощи) на счёт удаления скобок "(*" не принимаются. Скажем дружно- нафиг нужно!
Сообщение отредактировал Alexander - Суббота, 29.11.2008, 08:22
Ну вот смотри я делал теми же функциями "(*" и "*)" но оно чото не пахает:
Code
var s:string; st,fin,din,nt:word; f,f1:text; begin assign(f,'z1.dat'); reset(f); assign(f1,'z1.sol'); rewrite(f1); while not eof(f) do begin ReadLn(f,s); st:=Pos('{',s); While st <> 0 do begin fin:=Pos('}',s); if fin<>0 then delete(s,st,fin-st+1) else begin delete(s,st,Length(s)- fin+1); writeLn(f1,s); readln(f,s); fin:=Pos('}',s); while fin = 0 do begin readln(f,s); fin:=Pos('}',s); end; delete(s,1,fin); end; st:=Pos('{',s); if st<>0 then writeln(f1,s); end; writeln(f1,s); begin ReadLn(f,s); nt:=Pos('(*',s); While nt <> 0 do begin din:=Pos('*)',s); if din<>0 then delete(s,nt,din-nt+1) else begin delete(s,nt,Length(s)- din+1); writeLn(f1,s); readln(f,s); din:=Pos('*)',s); while din = 0 do begin readln(f,s); din:=Pos('*)',s); end; delete(s,1,din); end; nt:=Pos('(*',s); if nt<>0 then writeln(f1,s); end; end; writeln(f1,s); end; close(f); close(f1); end.
Я - желанный гость Сайта взаимопомощи программистам Pascal А ты?
совсем не так. Если хочешь не использовать дополнительных файлов, то тебе придётся проверять какая скобка в строке идёт раньше и в зависимости от этого пускать нужный цикл. В любом случае удаление одного блока комментариев нужно выделить в отдельную процедуру. Скажем дружно- нафиг нужно!
сначала удаляешь скобки одного вида и пишешь результат в дополнительный файл, затем из полученного файла удаляешь скобки второго вида. Скажем дружно- нафиг нужно!
var s:string; st,fin,din,nt:word; f,f1,f2:text; begin assign(f,'z1.dat'); reset(f); assign(f1,'z1.sol'); rewrite(f1); assign(f2,'z2.sol'); while not eof(f) do begin reset(f2); ReadLn(f,s); st:=Pos('{',s); While st <> 0 do begin fin:=Pos('}',s); if fin<>0 then delete(s,st,fin-st+1) else begin delete(s,st,Length(s)- fin+1); writeLn(f2,s); readln(f,s); fin:=Pos('}',s); while fin = 0 do begin readln(f,s); fin:=Pos('}',s); end; delete(s,1,fin); end; st:=Pos('{',s);
if st<>0 then writeln(f2,s); close(f2); end; begin reset(f2); while not eof(f2) do ReadLn(f2,s); nt:=Pos('(*',s); While nt <> 0 do begin din:=Pos('*)',s); if din<>0 then delete(s,nt,din-nt+1) else begin delete(s,nt,Length(s)- din+1); writeLn(f1,s); readln(f2,s); din:=Pos('*)',s); while din = 0 do begin readln(f2,s); din:=Pos('*)',s); end; delete(s,1,din); end; nt:=Pos('(*',s); if nt<>0 then writeln(f1,s); end; end; writeln(f1,s); end; close(f2); close(f1); close(f); end.
Помоги ,а!
Добавлено (01.12.2008, 18:06) --------------------------------------------- Ну вот вроди всьо правильно, вот только удаляет коментарии и оставляет пустую строку!:
Code
var s,t:string; st,fin,nt,bin:word; f,f1:text; begin assign(f,'z1.dat'); reset(f); assign(f1,'z1.sol'); rewrite(f1); while not eof(f) do begin ReadLn(f,s); st:=Pos('{',s);
While st <> 0 do begin fin:=Pos('}',s); if fin<>0 then delete(s,st,fin-st+1) else begin delete(s,st,Length(s)- fin+1); writeLn(f1,s); readln(f,s); fin:=Pos('}',s); while fin = 0 do begin readln(f,s); fin:=Pos('}',s); end; delete(s,1,fin); end; st:=Pos('{',s); if st<>0 then writeln(f1,s); end; nt:=Pos('(*',s); While nt <> 0 do begin bin:=Pos('*)',s); if bin<>0 then delete(s,nt,bin-nt+2) else begin delete(s,nt,Length(t)- bin+2); writeLn(f1,s); readln(f,s); bin:=Pos('*)',s); while bin = 0 do begin readln(f,s); bin:=Pos('*)',s); end; delete(s,1,bin); end; nt:=Pos('(*',s); if nt<>0 then writeln(f1,s); end; writeln(f1,s); end; close(f); close(f1); end.
Alexander, Seqular, помогите! Я - желанный гость Сайта взаимопомощи программистам Pascal А ты?
