
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.