Ввод строки типа Pchar Опции

[ammaximus]

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

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

Тебе нужна процедура типа:

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]

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

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

[volvo]

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

[xds]

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 0:55

[xds]

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

[ammaximus]

Здесь 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]

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

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

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

[ammaximus]

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

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

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

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

[xds]

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

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

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 - 15.11.2006 22:11

[ammaximus]

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

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

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

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

[volvo]

не лезут строки более 127

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

[ammaximus]

... Странно

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

[volvo]

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

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

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

[xds]

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

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

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

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

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

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