Неправильно работает код удаления слова из строки Опции

[-студент-]

Дана строка типа слово1 слово2 слово3 слово1
Надо чтобы после парсинга строки удалились дубликаты те получилось
слово1 слово2 слово3

Код

var
  t,single:string;
  i,j:integer;


function word(t_temp:string; var count: integer):string;
  var
    l1,l2:integer;
  begin
    delete(t_temp, 1, count);
    l1:=pos(' ', t_temp);
    l2:=pos(',', t_temp);
    while (l1=1) or (l2=1) do
      begin
        l1:=pos(' ', t_temp);
        l2:=pos(',', t_temp);
        if (l1=1) or (l2=1) then
          begin
            delete(t_temp,1,1);
            inc(i);
          end;
      end;
    if l1<l2 then
      begin
       result:=copy(t_temp,1,l1);
       inc(count, l1)
      end
    else
      begin
        result:=copy(t_temp,1,l2);
        inc(count,l2);
      end;
end;

function double(t_temp:string; sub:string; vaar count:integer):boolean;
  begin
    delete(t_temp,1,count);
    j:=pos(sub,t_temp);
    if j= 0 then result:=false
    else
      result:=true;
  end;

procedure cut(var str:string; sub:string; var count:integer);
  begin
    j:=pos(sub,str);
     while j<>0 do
      begin
        j:=pos(sub,str);
        delete(str,j,length(sub));
      end;
  end;

begin
  writeln('Enter your string...');
  readln(t);
  i:=0;
  while i<=length(t) do
    begin
      single:=word(t,i);
      if double(t,single,i) then
        cut(t,single,i)
      else inc(i);
    end;
  writeln(t);
  readln;
end.

Помогите пожалуйста

[GuRman]

ну у меня задача еще немного отличалась но этот код получился таким

Код

const
  limits = [#32, ',', '.'];

type
  wrd_info = record
    start, len: byte;
  end;
  tarr= array of wrd_info;
{

  Здесь - реализация get_words ...

}

procedure kill_doubles(var s:string; var wrd: tarr);
var
  i,j,k,l:integer;
begin
  i:=0;
  while i<= high(wrd) do begin
      j:=i+1;
      while j<=high(wrd) do begin
          if copy(s,wrd[i].start,wrd[i].len) = copy(s,wrd[j].start,wrd[j].len) then
            begin
              delete(s,wrd[j].start,wrd[j].len);
              for k:=j+1 to length(wrd) do wrd[k-1]:=wrd[k];
              setlength(wrd, length(wrd)-1);
              for k:=j to length(wrd) do
                with wrd[k] do start:=start-wrd[i].len;
            end
            else
          inc(j);
        end;
      inc(i);
    end;
end;

var
  words: tarr;
  s:string;
  i:integer;

begin
  writeln('Enter your string...');
  readln(s);
  get_wrd(s, words);
  kill_doubles(s,words);
  writeln(s);
  readln;
end.

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

ЗЫ замечания? 8)

Сообщение отредактировано: GuRman - 16.02.2006 0:04

[volvo]

ЗЫ замечания? 8)

А можешь полностью свою программу приаттачить? Я попробовал переделать get_words в процедуру, но у меня в kill_doubles программа вываливается (FPC 2.0.0) ... Ты чем компилировал?