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

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

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

 
 Ответить  Открыть новую тему 
> Ввод строки типа Pchar
сообщение
Сообщение #1


Ночной волк
**

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

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


В задаче ввод из входного потока.
Ввести 2 длинные строки.
программа<файл:
строка1
строка2

Ну я и пишу
Код

{X+}
var a,b:PChar;
    an,bn:integer;
    c:char;
    flag:boolean;
begin
{Intro}
flag:=True;
an:=0;
while flag do
begin
    read(c);
  If ord(c)=13 then
   flag:=false
  else a[an]:=c;
  inc(an);
end;
flag:=True;
bn:=1;
while flag do
begin
  read(c);
  If ord(c)=13 then
  flag:=false
  else b[bn]:=c;
  inc(bn);
end;
{/Intro}
writeln(a);
writeln(b);


readln;
end.


А как писать правильно? Как организовать ввод, если неизвестно кол-во символов?


--------------------
Не думай о белой обезьяне.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
Как организовать ввод, если неизвестно кол-во символов?

Тебе нужна процедура типа:
procedure input_pchar(var p: pchar);
var i: integer;
begin
i := -1;
repeat
inc(i);
p[i] := readkey; write(p[i]);
until p[i] = #13;
p[i + 1] := #0;
end;

{ Использовать так: }
var a: PChar;
begin
new(a);
input_pchar(a);

writeln;
writeln(a);
dispose(a);
end.
Теперь ты можешь ввести строку любой длины (можно в repeat/until ввесли дополнительные условия для отсечения нежелательных комбинаций, например, нажатий клавиш с расширенными кодами)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


N337
****

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

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


volvo, ты заблуждаешься: PChar - указатель на символ, а не динамическая строка. New(a) выделяет место только под один символ. Почитай внимательнее, что написал...

Сообщение отредактировано: xds -


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Правда? И что же я написал такого, что в корне неверно или не будет работать? То, что сделал new()/dispose()? Тогда попробуй БЕЗ них прогнать программу... 34-ый символ ты уже не введешь, программа повиснет... Объяснишь?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


N337
****

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

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


2 volvo
Работать будет, но в корне неверно, т. к. разрушает содержимое кучи:
uses Crt;

procedure input_pchar(var p: pchar);
var i: integer;
begin
i := -1;
repeat
inc(i);
p[i] := readkey; write(p[i]);
until p[i] = #13;
p[i + 1] := #0;
end;

{ Использовать так: }
var a: PChar;
t: PChar;
begin
new(a);

new(t);
t^ := 'x';

input_pchar(a);

writeln;
writeln(a);
dispose(a);

Writeln(t^);

dispose(t);
end.

Попробуй повводить строки подлиннее (символов по 40-60) и понаблюдай за значением t^ (которое, по-твоему, не должно меняться)...

Сообщение отредактировано: xds -


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


N337
****

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

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


program LongStr;

uses
Crt, Strings;

procedure Realloc(var p: Pointer; OldSize, NewSize: Word);
var
t: Pointer;
begin
GetMem(t, NewSize);
if p <> nil then
begin
if OldSize < NewSize then
Move(p^, t^, OldSize)
else
Move(p^, t^, NewSize);
FreeMem(p, OldSize);
end;
p := t;
end;

function ReadLongStr: PChar;
var
Buf: array[0..255] of Char;
c: Char;
i, n: Integer;
r: PChar;
begin
r := nil;
n := 0;
repeat
i := 0;
while i < SizeOf(Buf) do
begin
c := ReadKey;
if c = #13 then Break;
Write( c );
Buf[i] := c;
Inc(i);
end;
Realloc(Pointer( r ), n, n + i + 1);
Move(Buf, r[n], i);
Inc(n, i);
until c = #13;
Writeln;
r[n] := #0;
ReadLongStr := r;
end;

procedure FreeLongStr(s: PChar);
begin
FreeMem(s, StrLen(s) + 1);
end;

var
a, b: PChar;

begin
a := ReadLongStr;
b := ReadLongStr;
Writeln(a);
Writeln(b);
FreeLongStr(a);
FreeLongStr(b);
end.

Всё, пошёл спать... (кстати, (с) в коде заменяется на символ ©, в r в том же месте - на ®)

Сообщение отредактировано: xds -


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Ночной волк
**

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

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


Здесь Volvo ошибся, однако исправляется это просто:
Добавим New(р) непосредственно в процедуру - получаем:
uses Crt;

procedure input_pchar(var p: pchar);
var i: integer;
begin
new(p);
i := -1;
repeat
inc(i);
p[i] := readkey; write(p[i]);
until p[i] = #13;
p[i + 1] := #0;
end;


var a: PChar;
t: PChar;
begin
new(a);{Это не мешает, хотя не обязательно}
new(t);
t^ := 'x';
input_pchar(a);

writeln;
writeln(a);
dispose(a);

Writeln(t^);

dispose(t);
end.

В таком случае процедуру можно назвать Organize иди Create и объявлять до нее ничего не нужно.
Ваше решение, xds, возможно и верное, но какое-то громоздкое=>неопциональное.


--------------------
Не думай о белой обезьяне.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


N337
****

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

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


Цитата
Добавим New(р) непосредственно в процедуру - получаем:

То же самое... New для указателя PChar выделяет место под один единственный символ, прничём размер выделенной области никакими стандартными средствами изменяться не будет, т. е. p[1] уже не принадлежит выделенному блоку. Кроме того, Вы сделали утечку памяти, т. к. указатель, выделенный new(a) безвозвратно теряется.

Сообщение отредактировано: xds -


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Ночной волк
**

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

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


Цитата(xds @ 15.11.2006 5:59) *

То же самое... New для указателя PChar выделяет место под один единственный символ, прничём размер выделенной области никакими стандартными средствами изменяться не будет, т. е. p[1] уже не принадлежит выделенному блоку.

Он не будет принадлежать выделенному участку, но разрушать кучу это не будет. По-крайней мере я не могу создать комбинацию, при которой это происходит
В рамках моей задачи такой вариант подходит, однако правильнее все-же отслеживать состояние кучи.

Цитата(xds @ 15.11.2006 5:59) *

Кроме того, Вы сделали утечку памяти, т. к. указатель, выделенный new(a) безвозвратно теряется.

А он ведь больше не нужен. Мы же вводим новое значение a, а старое преобразуется в мусор. Только мусорить так, наверное, некоректно. Получается что-то вроде
10101010
10101010
11101010
10010101
мусор --> сюда особо ничего не влезет, не экономное использование памяти.
10010101
Нужно подкорректировать и поменять на функцию. Не знаю будет ли работать, стоит попробовать.


--------------------
Не думай о белой обезьяне.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


N337
****

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

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


Цитата
По-крайней мере я не могу создать комбинацию, при которой это происходит
В рамках моей задачи такой вариант подходит, однако правильнее все-же отслеживать состояние кучи.
При чтении таким образом двух строк одна из них будет затирать содержимое другой. Кроме того, во всех предложенных выше вариантах не работает пененаправление ввода, необходимое по условию задачи. Вот мой исправленный вариант:
program LongStr;

uses
Strings;

procedure Realloc(var p: Pointer; OldSize, NewSize: Word);
var
t: Pointer;
begin
GetMem(t, NewSize);
if p <> nil then
begin
if OldSize < NewSize then
Move(p^, t^, OldSize)
else
Move(p^, t^, NewSize);
FreeMem(p, OldSize);
end;
p := t;
end;

function ReadLongStr: PChar;
var
Buf: array[0..255] of Char;
c: Char;
i, n: Integer;
r: PChar;
begin
r := nil;
n := 0;
repeat
i := 0;
while not Eoln and (i < SizeOf(Buf)) do
begin
Read( с );
Buf[i] := c;
Inc(i);
end;
Realloc(Pointer( r ), n, n + i + 1);
Move(Buf, r[n], i);
Inc(n, i);
until Eoln;
Readln;
r[n] := #0;
ReadLongStr := r;
end;

procedure FreeLongStr(s: PChar);
begin
FreeMem(s, StrLen(s) + 1);
end;

var
a, b: PChar;

begin
a := ReadLongStr;
b := ReadLongStr;
Writeln(a);
Writeln(b);
FreeLongStr(a);
FreeLongStr(b);
end.


Сообщение отредактировано: xds -


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Ночной волк
**

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

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


Цитата
При чтении таким образом двух строк одна из них будет затирать содержимое другой

Не знаю... У меня работает нормально при даже оч. длинных строках. CRT мешает перенаправлению, однако мне бы хотелось использовать некоторые процедуры оттуда. Нет ли у кого искодника CRT?

Спасибо за помощь, xds.

volvo, в программу, которую вы предложили в первый раз не лезут строки более 127...


--------------------
Не думай о белой обезьяне.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Цитата
не лезут строки более 127
Я вводил больше 400, ты мне говоришь 127... Странно.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Ночной волк
**

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

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


Цитата
... Странно

Пищит на 128-й типа переполнен буфер. Возможно ошибка компиляции...


--------------------
Не думай о белой обезьяне.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






А вообще... Я заглянул в модуль Strings... Смотри-ка:
{$X+}
uses crt, strings;

var
buffer: array[0 .. pred(maxint)] of char;

procedure input_pchar(var p: pchar);
var i: integer;
begin
i := -1;
repeat
inc(i);
buffer[i] := readkey; write(buffer[i]);
until buffer[i] = #13;
writeln;
buffer[i + 1] := #0;
p := strnew(buffer); { копируем из статического буфера в динамическую переменную }
end;

var
a: PChar;
begin
writeln('program start:: ', memavail);
input_pchar(a);

writeln('A string entered:: ', memavail);

writeln(a);
strdispose(a); { и удаляем A }
writeln('A string deleted:: ', memavail);
end.

По-моему, так накладок быть не должно. Хотя я уже ни в чем не уверен...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Ночной волк
**

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

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


А... Strnew... Интересно...
Много лишней памяти расходуется, буферный массив на 32,5 Кбайт, из них в реальности понадобятся где-нибудь 5%... Тем более здесь уже известно максимальное количество символов - MaxInt-1.
У нас - неизвестно.

P.S. Выложите, пожалуйста, модуль Strings.


--------------------
Не думай о белой обезьяне.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


N337
****

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

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


Цитата
Я вводил больше 400, ты мне говоришь 127... Странно.
Ничего странного: программа, содержащая ошибки при работе с динамической памятью, ведёт себя непредсказуемо. Очень последовательный результат.

Последний вариант выглядит работоспособным. Попытка ввести строки больше 32 Кб с какой-то вероятностью его "грохнет", в конец строки перед #0 попадает #13... всё это, впрочем, несущественно. Вводить можно было с помощью Read, т. к. по условию ввод перенаправляется из файла и проблем с ограничением на 255 символов не возникает (видимо, для этого и предложили ввод с перенаправлением).

Цитата
P.S. Выложите, пожалуйста, модуль Strings.

Стандартный модуль, описан в хелпе.

Сообщение отредактировано: xds -


Прикрепленные файлы
Прикрепленный файл  strings.zip ( 2.18 килобайт ) Кол-во скачиваний: 63


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 28.09.2020 19:59
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name