Stian Søiland, IT 111, øvingsgruppe 15 (stud.ass. Kari Alvheim)
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; ListBox1: TListBox; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); type filpeker = ^filnode; ordpeker = ^ordnode; filnode = record fil : string; neste : filpeker; end; ordnode = record ord : string; filhode : filpeker; neste : ordpeker; end; var filhode:filpeker; ordhode:ordpeker; // Prosedyre for å lese inn filnavn. Returnerer peker til første // dynamiske variabel med filnavn. procedure lesinnfilnavn(var filhode:filpeker); var tittel,instruksjon,temp:string; hode,neste:filpeker; begin // Initierer tittel := 'Filanalysering'; instruksjon := 'Fil som skal legges til? (Tomt felt avslutter)'; // Lager første node hode := new(filpeker); neste := filhode; // Leser inn første filnavn temp := InputBox(tittel,instruksjon,''); while (temp <> '') do begin // Lager en ny node for hvert filnavn som blir lest inn neste.fil := temp; neste.neste := new(filpeker); temp := InputBox(tittel,instruksjon,''); end; // Sjekker om ingen filnavn er skrevet inn if (hode.fil = '') then filhode := nil else begin // Returnerer hodet filhode := hode; // Avslutter siste node neste.neste := nil; end; end; // slutt lesinnfilnavn // prosedyre for å analysere filene procedure analyserfiler(filhode:filpeker; var ordhode:ordpeker); procedure lesfil(filnavn:string; var fil:string); var filen,temp:string; fil1:textfile; begin // åpner fil for lesing AssignFile(fil1,filnavn); Reset(fil1); // initierer filen := ''; temp := ''; // Leser inn filen til en eneste stor tekststreng. // En tekststreng kan være opptil 2 GB stor. Større filer enn det // anser jeg som usannsynlig. while not eof(fil1) do begin // Leser linje, setter inn mellomrom mellom ord på hver linje filen := filen + ' ' + temp; readln(fil1,temp); end; // lukker åpen fil CloseFile(fil1); // Returnerer filinnhold fil := filen; end; // slutt lesfil // Prosedyre for å filtrere bort alle tegn som ikke er bokstaver eller mellomrom procedure filtrering(var fil:string); var temp : string; a,b,i : integer; begin temp := ''; // behandler hvert tegn i filen for i:=1 to length(fil) do begin a := ord(fil[i]); b := ord(fil[i+1]); // Inkluderer tegnet dersom det er et mellomrom eller en bokstav // mellomrom, neste ikke mellomrom case a of 32: if b<>32 then temp := temp + ' '; // mellomrom hvis neste ikke mellomrom 65..90: temp := temp + chr(a+32); // store -> små 97..122: temp := temp + chr(a); // små 140,159,161: temp := temp + chr(a); // rare tegn 192..223: if (a<>215) then temp := temp + chr(a+32); // store aksenttegn -> små 224..255: temp := temp + chr(a); // små aksentegn end; // slutt case end; // slutt sløyfe // Den filtrerte filen returneres fil := temp; end; // slutt filtrering procedure gimegetord(var fil,ord:string); var posisjon : integer; begin // finner første mellomrom posisjon := pos(' ',fil); // første ord returneres, ekslusivt mellomrommet ord := copy(fil,1,posisjon-1); // resten av filen returneres, ekslusivt mellomrommet fil := copy(fil,posisjon,length(fil)); end; // slutt gimegetord // Prosedyre for å plassere ord i lenket liste procedure plasserord(ord,filnavn:string; neste:ordpeker); var funnet,funnet2:boolean; neste2:filpeker; begin // initiering funnet := false; // søker i lenket liste while not funnet do begin // elementet finnes ikke i listen fra før, skal legges til if neste=nil then begin funnet := true; // Lager ny filnode neste := new(ordpeker); // Setter inn ordet i noden neste.ord := ord; // Lager ny node for den aktuelle filen neste.filhode := new(filpeker); // Dette er den nye sistenoden neste.neste := nil; // Filnavnnoden legges til neste.filhode.fil := filnavn; // Dette er siste filnavnnode neste.filhode.neste := nil; end else // sjekker om elementet er likt ordet if neste.ord = ord then // plasserer begin funnet := true; funnet2 := false; neste2 := neste.filhode; // søker i lenket liste while not funnet2 do begin if neste2 = nil then // ikke funnet i listen, legger til begin funnet2 := true; neste2 := new(filpeker); neste2.fil := filnavn; neste2.neste := nil; end else begin // Hvis den finnes fra før, gjøres ingenting. Søkingen er ferdig. if neste2.fil = filnavn then funnet2 := true; // Går videre til neste element neste2 := neste2.neste; end; end; end // slutt plassering av ord i funnet node // neste element skal sjekkes else neste := neste.neste; end; // slutt søking i lenket liste end; // slutt plasserordprosedyre // Hoveddel av analyserfiler-prosedyren starter var nestefil:filpeker; temp,fil:string; begin // initierer nestefil := filhode; // analyserer hver fil for seg while (nestefil <> nil) do begin lesfil(nestefil.fil,fil); // går gjennom hvert ord for seg while (fil <> '') do begin filtrering(fil); gimegetord(fil,temp); plasserord(temp,nestefil.fil,ordhode); end; // slutt ordprosessering end; // slutt filgjennomgang end; // slutt analyserfiler procedure utskrift(ordhode:ordpeker); var nesteord:ordpeker; nestefil:filpeker; temp:string; begin nesteord := ordhode; // Gjennomløper alle ordene while (nesteord<>nil) do begin temp := nesteord.ord; nestefil := nesteord.filhode; // Gjennomløper alle filnodene while (nestefil<>nil) do begin // legger til filnavnet temp := temp + ' ' + nestefil.fil; // neste filnode nestefil := nestefil.neste; end;// slutt filnodegjennomløping // skriver ut. Temp-variabelen blir nullstilt ved neste gjennomløping ListBox1.Items.Add(temp); //neste ord nesteord := nesteord.neste; end;// slutt ordgjennomløping end; // slutt utskrift // Prosedyre for å fjerne ord som eksisterer i Stoplist.txt procedure stopp(var ordhode:ordpeker); type stoppmatrisetype=array[0..99] of string; var stoppmatrise:stoppmatrisetype; siste:integer; // prosedyre for å lese inn Stoplist.txt procedure lesinnstopplist(var stoppmatrise:stoppmatrisetype; var siste:integer); var fil:textfile; linje:string; temp:stoppmatrisetype; i:integer; begin // initier tempmatrise for i:=0 to 99 do temp[i]:=''; AssignFile(fil,'Stoplist.txt'); Reset(fil); i:=0; while (not eof(fil)) and (i<100) do begin // Leser linje readln(fil,linje); // Plasserer linje i matrisen temp[i] := linje; // øker telleren i:=i+1; end; // slutt innlesing CloseFile(fil); // Returnerer matrisen med stoppord stoppmatrise := temp; // Returnerer det siste stoppordets linjenummer siste := i-1; end; // slutt lesinnstopplist // prosedyre for å fjerne stoppord procedure fjernstoppord(stoppmatrise:stoppmatrisetype; siste:integer; var ordhode:ordpeker); var neste:ordpeker; i:integer; funnet:boolean; begin // Gjennomløper alle ordene neste := ordhode; while (neste<>NIL) do begin // Gjennomløper hvert ord i stopplisten funnet := false; i:=0; while (not funnet) and (siste>i) do begin funnet := (neste.ord=stoppmatrise[i]); i:=i+1; end; // slutt stopplistordgjennomløping // Dersom ordet ble funnet i stopplisten, vil postpekeren som tidligere // pekte på den dynamiske variabelen som inneholdt det forbudte ordet // satt til å peke mot den neste dynamiske variabelen i den lenkede // listen istedetfor. Dermed forsvinner det forbudte ordet // ut av den lenkede listen (men opptar fortsatt plass i indre lager) if funnet then neste := neste.neste; // Til neste ord neste := neste.neste; end; end; // slutt fjernstoppord begin lesinnstopplist(stoppmatrise,siste); fjernstoppord(stoppmatrise,siste,ordhode); end; // slutt stopp begin lesinnfilnavn(filhode); analyserfiler(filhode,ordhode); // følgende linje kun for oppgave b) stopp(ordhode); utskrift(ordhode); end; end.