IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> проблемма с программой
Slang
сообщение 7.05.2005 17:02
Сообщение #1


Гость






 
program gop2;
uses crt;

var
  q,l,i      : integer;
  f1,f2      : text;
  p,qq       : char;
  s          : string;
  name,name1 : string[80];
procedure newfile;
begin
  write('enter file name f1:');
  readln(name);
  assign(f1,name);
  rewrite(f1);
  writeln('text:');
  readln(s);
  write(s);
  writeln(f1,s);
  readln;
end;
procedure work;
begin
    write('enter file name f1:');
    readln(name);
    assign(f1,name);
    reset(f1);
    write('enter file name f2:');
    readln(name1);
    assign(f2,name1);
    rewrite(f2);
    qq:=' ';
    l:=length(s);
    for i:=1 to l do
      begin
        if (s[i]='-') then
          begin
            while (not eof(f1) and (s[i]<>' ')) do
            read(f1,s[i]);
          end;
    if ((s[i]<>'-') and (s[i]<>' ')) then
         write(f2,s[i]);
    if (s[i]=' ') then
       write(f2,qq);
    if (not eof(f1)) then
        read(f1,s[i]);
     end;
  reset(f1);
  reset(f2);
end;
procedure view;
begin
   write('enter file name:  ');
   readln(name);
   writeln;
   assign(f1,name);
   reset(f1);
   while not eof(f1) do
       begin
            read(f1,qq);
            write(qq);
       end;
   readln;
end;
begin
   repeat
   clrscr;
   writeln('                        =============menu==============');
   writeln('                        1 - create new file            ');
   writeln('                        2 - run program                ');
   writeln('                        3 - view file                  ');
   writeln('                        4 - exit                       ');
   writeln('                        ===============================');
   readln(q);
   clrscr;
   case q of
         1: newfile;
         2: work;
         3: view;
   end;
   until q=4;
end.


в этой программе не работает procedure newfile
она не записывает строку в файл, и файл получается пустой...
помогите решить проблему
 К началу страницы 
+ Ответить 
 
  Ответить  Открыть новую тему 
Ответов
slang
сообщение 7.05.2005 17:32
Сообщение #2





Группа: Пользователи
Сообщений: 7
Пол: Мужской

Репутация: -  0  +

поторопился с выводами...вообщем все работает, вот только в новом файле в начале дописывается странный символ, а так все ок, вот текст программы попробуйте и по возможности подскажите

program gop2;
uses crt;

var
  q,l,i      : integer;
  f1,f2      : text;
  p,qq       : char;
  s          : string;
  name,name1 : string[80];
procedure newfile;
begin
  write('enter file name f1:');
  readln(name);
  assign(f1,name);
  rewrite(f1);
  writeln('text:');
  readln(s);
  writeln(f1,s);
  close(f1);
end;
procedure work;
begin
    write('enter file name f1:');
    readln(name);
    assign(f1,name);
    reset(f1);
    write('enter file name f2:');
    readln(name1);
    assign(f2,name1);
    rewrite(f2);
    qq:=' ';
    while not eof(f1) do
      begin
        if (s[i]='-') then
          begin
            while (not eof(f1) and (s[i]<>' ')) do
            read(f1,s[i]);
          end;
    if ((s[i]<>'-') and (s[i]<>' ')) then
         write(f2,s[i]);
    if (s[i]=' ') then
       write(f2,qq);
    if (not eof(f1)) then
        read(f1,s[i]);
     end;
  close(f1);
  close(f2);
end;
procedure view;
begin
   write('enter file name:  ');
   readln(name);
   writeln;
   assign(f1,name);
   reset(f1);
   while not eof(f1) do
       begin
            read(f1,qq);
            write(qq);
       end;
   readln;
end;
begin
   repeat
   clrscr;
   writeln('                        =============menu==============');
   writeln('                        1 - create new file            ');
   writeln('                        2 - run program                ');
   writeln('                        3 - view file                  ');
   writeln('                        4 - exit                       ');
   writeln('                        ===============================');
   readln(q);
   clrscr;
   case q of
         1: newfile;
         2: work;
         3: view;
   end;
   until q=4;
end.



Сообщение отредактировано: slang - 7.05.2005 17:33


Прикрепленные файлы
Прикрепленный файл  GOP_2.PAS ( 1.75 килобайт ) Кол-во скачиваний: 249
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Slang   проблемма с программой   7.05.2005 17:02
Altair   ты файл закрыть забываешь procedure newfile; begin...   7.05.2005 17:06
slang   все работает спасибо!   7.05.2005 17:11
slang   поторопился с выводами...вообщем все работает, вот...   7.05.2005 17:32
volvo   А происходит это потому, что ты обращаешься к s[i]...   7.05.2005 17:48
slang   ок...попробую, есть ещё один способ реализации эт...   7.05.2005 17:58
slang   while not eof(f1) do begin if (p=...   7.05.2005 18:04
volvo   Это не подойдет? FAQ: Строки   7.05.2005 18:00
slang   сложновата реализация...а попроще нельзя? для мое...   7.05.2005 18:09
volvo   Ну, и что? Опять же, ты прочел символ в P прежде ч...   7.05.2005 18:10
slang   что значит прочел p прежде чем сравнить с '-...   7.05.2005 18:16
volvo   Так вот то-то и оно, что нету !!! При ...   7.05.2005 18:20
slang   все спасибо...все работает!   7.05.2005 18:28

« Предыдущая тема · Задачи · Следующая тема »
 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

Режим отображения: Переключить на: Стандартный · Переключить на: Линейный · Древовидный

Подписка на тему · Сообщить другу · Версия для печати · Подписка на этот форум

- Текстовая версия 21.07.2025 11:10
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"