Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Ввод строки типа Pchar

Автор: ammaximus 14.11.2006 20:13

В задаче ввод из входного потока.
Ввести 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.


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

Автор: volvo 14.11.2006 21:13

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

Тебе нужна процедура типа:
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 ввесли дополнительные условия для отсечения нежелательных комбинаций, например, нажатий клавиш с расширенными кодами)

Автор: xds 15.11.2006 0:24

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

Автор: volvo 15.11.2006 0:33

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

Автор: xds 15.11.2006 0:53

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 15.11.2006 1:15

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 в том же месте - на ®)

Автор: ammaximus 15.11.2006 2:41

Здесь 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, возможно и верное, но какое-то громоздкое=>неопциональное.

Автор: xds 15.11.2006 9:59

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

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

Автор: ammaximus 15.11.2006 17:17

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

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

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

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

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

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

Автор: xds 15.11.2006 18:25

Цитата
По-крайней мере я не могу создать комбинацию, при которой это происходит
В рамках моей задачи такой вариант подходит, однако правильнее все-же отслеживать состояние кучи.
При чтении таким образом двух строк одна из них будет затирать содержимое другой. Кроме того, во всех предложенных выше вариантах не работает пененаправление ввода, необходимое по условию задачи. Вот мой исправленный вариант:
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.

Автор: ammaximus 15.11.2006 18:46

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

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

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

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

Автор: volvo 15.11.2006 19:52

Цитата
не лезут строки более 127
Я вводил больше 400, ты мне говоришь 127... Странно.

Автор: ammaximus 15.11.2006 21:15

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

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

Автор: volvo 15.11.2006 21:30

А вообще... Я заглянул в модуль 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.

По-моему, так накладок быть не должно. Хотя я уже ни в чем не уверен...

Автор: ammaximus 15.11.2006 21:54

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

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

Автор: xds 15.11.2006 21:59

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

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

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

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


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