Usuwanie duplikatow z pliku txt - prawie OK

Witam, mam mala prosbe : czy ktos moglby przejrzec ponizszy kod i zastanowic sie co by zmienic aby faktycznie procedurka usuwala duplikaty, niby jest OK bo sie compiluje ale nie chce tego robic :

PROGRAM slownik;
USES
   crt;
CONST
  baza = 'c:\tp\prog2\slowa.txt' ;
  litery = ['a'..'z','A'..'Z'];
  liczba_rekordow = 50;

VAR
  G        : TOsobaWsk;
  Wyrazy   : TTablicaWyrazow;
  Wyraz,
  Nazwa    : string;
  Plik   : Text;
  Linia ,
  Ilosc ,
  I ,
  Indeks   : Integer;
  
TYPE
  TSlowaWsk = ^TSlowa;
     TSlowa = record
     wyraz : string;
     next  : TSlowaWsk;
  END;

Type
   Plik_slow = record
       slo : string ;
       slo2 : string;
       end;
type
Plinia=^Tlinia;
Tlinia=record
       nlinia:string;
       nast:Plinia;
       end;
TTablicaWyrazow = array[1..liczba_rekordow] of TSlowa;

PROCEDURE duplikat(var glowa : TSlowaWsk);
VAR
pom : TSlowaWsk;
pom2 : TSlowaWsk;
wsk : TSlowaWsk;

BEGIN
assign(plik,baza);
   Reset(plik);
    if IOresult=0 then begin
        indeks := 0;
        while not eof(plik) do begin
        inc(indeks);
         readln(plik, wyrazy[indeks].wyraz);
end;
      ilosc := indeks;
    end
      else begin
        rewrite(plik);
        ilosc:=0;
      end;
pom := glowa^.next;
   repeat
     pom2 := pom;
       repeat
         if (pom2^.next <> nil) and (pom^.wyraz = pom2^.next^.wyraz) then
          begin
            wsk := pom2^.next;
            pom2^.next := wsk^.next;
            dispose(wsk);
          end
       else
          pom2 := pom2^.next;
       until pom2 = nil;
     pom := pom^.next;
   until pom = nil;
END;

PROCEDURE inicjuj(var glowa : TOsobaWsk);
BEGIN
  new(glowa);
  glowa^.next := nil;
END;

PROCEDURE WstawNaPocz(var glowa : TOsobaWsk; liczba : string);
VAR
  pom : TOsobaWsk;
  ins : integer;
BEGIN
  new(pom);
  pom^.wyraz := liczba; {wyrazy[ins].wyraz; <- nie dziala z tym}
  pom^.next := nil;

  if glowa^.next <> nil then
    pom^.next := glowa^.next;
  glowa^.next := pom;
END;

{ wyswietlanie listy z wartownikiem}
PROCEDURE PokazListe(glowa : TOsobaWsk);
VAR
  pom : TOsobaWsk;
BEGIN
  pom:=glowa^.next;
  while pom <> nil do
    begin
     { write(pom^.wyraz,' ');}
      pom:=pom^.next;
    end;
END;

moj kompilator to : Turbo Pacal 7.0

<font color="blue">//uzywaj tagow < delphi > - lofix</span>

O dżizu :)

Spróbuj to. Tutaj chodzi o to, że plik odczytuje się w Comboboxie i kasuje wszystkie duplikaty oraz puste wiersze. Popraw sobie to jak tam chcesz itd.

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
   var
  NewList: TStringList;
  Idx: Integer;
begin
if key=13 then
 begin
    shellexecute(handle,'open','iexplore',pchar(combobox1.Text),nil,sw_shownormal);
   ComboBox1.Items.Insert(0,ComboBox1.Text);

      NewList := TStringList.Create;
    try
        for Idx := 0 to combobox1.Items.Count -1 do
            if (NewList.IndexOf(comboBox1.Items[Idx]) = -1) and
               (comboBox1.Items[Idx] <> '')
            then NewList.Add(comboBox1.Items[Idx]);
        comboBox1.Items.Text := NewList.Text;
    finally
        NewList.Free;
          combobox1.Items.SaveToFile('www.txt');
      combobox1.Items.LoadFromFile('www.txt');
  combobox1.Items.SaveToFile('www.txt');
    combobox1.Items.LoadFromFile('www.txt');
end;
     end;
     end;

Konik napisał(a)

O dżizu :)

Spróbuj to. Tutaj chodzi o to, że plik odczytuje się w Comboboxie i kasuje wszystkie duplikaty oraz puste wiersze. Popraw sobie to jak tam chcesz itd.

Hmm zrobie to grzecznie i posluze sie komentarzem kolegi na temat Twej wypowiedzi :

buahah to jakiś mat#$ który nigdy nie programował na poważne
Ty mu piszesz o swojej liście dynamiznej, a on Ci pakuje liste jako typ TStringList,
to jest pomocniczy typ delphi do bazy danyh ktore sa robione w 10 min za pomoca samej myszki [;

Tak wiec wielce mi pomogles z tym problemem, na szczescie zostal on rozwiazany w nastepujacy sposob dzieki wskazowkom innego ludzia :

Program duplikat;
type 
  wyrazy = ^Twyrazy; 
  Twyrazy = record 
              slowo : string; 
              nast  : wyrazy; 
            end; 

var 
  plik : text; 
  G,pom: wyrazy; 
  wyrazik: string; 

procedure UsunDuplikaty(var glowa : wyrazy); 
var 
  wsk, pom, pom2: wyrazy; 
begin 
  pom:=glowa^.nast; 

  while pom <> nil do 
    begin 
      wsk:=pom; 
      while wsk^.nast <> nil do 
        begin 
          if (pom^.slowo = wsk^.nast^.slowo) then 
            begin 
              pom2:=wsk^.nast; 
              wsk^.nast:=pom2^.nast; 
              wsk^.nast:=nil; 
              dispose(pom2); 
            end 
          else 
            wsk:=wsk^.nast; 
        end; 
      pom:=pom^.nast; 
    end; 

end; 

procedure DodajNaK(var glowa: wyrazy; wyraz : string); 
var 
  pom,wsk : wyrazy; 
begin 

  pom:=glowa; 

  while pom^.nast<>nil do 
    pom:=pom^.nast; 


  new(wsk); 
  wsk^.nast:=nil; 
  wsk^.slowo:=wyraz; 

  pom^.nast:=wsk; 

end; 

begin 

  new(G); 
  G^.nast:=nil; 
  assign(plik,paramstr(1)); 
  reset(plik); 
  while not eof(plik) do 
    begin 
      readln(plik,wyrazik); 
      DodajNaK(G,wyrazik); 
    end; 
  close(plik); 

  UsunDuplikaty(G); 

  assign(plik,paramstr(1)); 
  rewrite(plik); 
  pom:=G^.nast; 
  while pom<>nil do 
    begin 
      writeln(plik,pom^.slowo); 
      pom:=pom^.nast; 
    end; 

  close(plik); 
end.

Konik napisał(a)

O dżizu :)
Spróbuj to. Tutaj chodzi o to, że plik odczytuje się w Comboboxie i kasuje wszystkie duplikaty oraz puste wiersze. Popraw sobie to jak tam chcesz itd.

Nie wiem, czy takie 'pomaganie' coś komuś da.. wystarczy popatrzeć, że kolega ma dosową aplikację..

mała poprawka do tamtego kodu :

procedure UsunDuplikaty(var glowa : wyrazy);
var
  wsk, pom, pom2: wyrazy;
begin
  pom:=glowa^.nast;

  while pom <> nil do
    begin
      wsk:=pom;
      while wsk^.nast <> nil do
        begin
          if (pom^.slowo = wsk^.nast^.slowo) then
            begin
              pom2:=wsk^.nast;
              wsk^.nast:=pom2^.nast;
              dispose(pom2);
            end
          else
            wsk:=wsk^.nast;
        end;
      pom:=pom^.nast;
    end;

end;

ano - teraz dziala lepiej ; ))