Синтаксический анализ строки
Приведу модуль, где я собрал большое количество программ этого типа.
Имена функций и комментарии написаны на шведском языке, но тем не менее разобраться с
тем, что делает код не так уж и сложно.
Например, для замены всех подстрок в тексте достаточно вызвать stringreplaceall с тремя параметрами - строкой, искомой подстрокой, заменяемой подстрокой и функция возвратит исправленную строку. Но будьте внимательны, заменяемая подстрока не должна быть составной частью искомой подстроки. В этом случае вы должны вызвать функцию дважды с различными параметрами (метод итерации), иначе вы получите бесконечный цикл.
Так, если у вас есть текст, содержащий слово Joe и вам необходимо заменить все вхождения этого слова на Joey,
необходимо сделать две итерации, сначала:
text := stringreplaceall (text,'Joe','Joeey');
и затем
text := stringreplaceall (text,'Joeey','Joey');
unit sparfunc; interface uses sysutils,classes; function antaltecken (orgtext,soktext : string) : integer; function beginsWith (text,teststreng : string):boolean; function endsWith (text,teststreng : string):boolean; function hamtastreng (text,strt,slut : string):string; function hamtastrengmellan (text,strt,slut : string):string; function nastadelare (progtext : string):integer; function rtf2sgml (text : string) : string; Function sgml2win(text : String) : String; Function sgml2mac(text : String) : String; Function sgml2rtf(text : string) : String; function sistamening(text : string) : string; function stringnthfield (text,delim : string; vilken : integer) : string; function stringreplace (text,byt,mot : string) : string; function stringreplaceall (text,byt,mot : string) : string; function text2sgml (text : string) : string; procedure SurePath (pathen : string); procedure KopieraFil (infil,utfil : string); function LasInEnTextfil (filnamn : string) : string; implementation function LasInEnTextfil (filnamn : string) : string; var infil : textfile;
temptext, filtext : string;
beginfiltext := '';
//Öppna angiven fil och läs in den
try
assignfile (infil,filnamn); //Koppla en textfilsvariabel till pathname
reset (infil); //Öppna filen
while not eof(infil) do begin //Så länge vi inte nått slutet
readln (infil,temptext); //Läs in en rad
filtext := filtext+temptext; //Lägg den till variabeln SGMLTEXT
end; // while
finally //slutligen
closefile (infil); //Stäng filen
end; //try
result := filtext;
end;procedure KopieraFil (infil,utfil : string); var InStream : TFileStream;
OutStream : TFileStream;
beginInStream := TFileStream.Create(infil,fmOpenRead);
try
OutStream := TFileStream.Create(utfil,fmOpenWrite or fmCreate);
try
OutStream.CopyFrom(InStream,0);
finally
OutStream.Free;
end;
finally
InStream.Free;
end;
end;procedure SurePath (pathen : string); var temprad,del1 : string;
antal : integer;
beginantal := antaltecken (pathen,'\');
if antal<3 then
createdir(pathen)
else begin
if pathen[length(pathen)] <> '\' then pathen := pathen+'\';
pathen := stringreplace(pathen,'\','/');
del1 := copy(pathen,1,pos('\',pathen));
pathen := stringreplace(pathen,del1,'');
del1 := stringreplace(del1,'/','\');
createdir (del1);
while pathen <> '' do begin
temprad := copy(pathen,1,pos('\',pathen));
pathen := stringreplace(pathen,temprad,'');
del1 := del1+ temprad;
temprad := '';
createdir(del1);
end;
end;
end;function antaltecken (orgtext,soktext : string) : integer; var i,traffar,soklengd : integer;
begintraffar := 0;
soklengd := length(soktext);
for i := 1 to length(orgtext) do
begin
if soktext = copy(orgtext,i,soklengd) then
traffar := traffar +1;
end;
result := traffar;
end;function nastadelare (progtext : string):integer; var i,j : integer;
begini := pos('.',progtext);
j := pos('!',progtext);
if (j<i) and (j>0) then i := j;
j := pos('!',progtext);
if (j<i) and (j>0) then i := j;
j := pos('?',progtext);
if (j<i) and (j>0) then i := j;
result := i;
end;function stringnthfield (text,delim : string; vilken : integer) : string; var start,slut,i : integer;
temptext : string;
beginstart := 0; if vilken >0 then begin
temptext := text;
if vilken = 1 then
begin
start := 1;
slut := pos (delim,text);
end
else
begin
for i:= 1 to vilken -1 do
begin
start := pos(delim,temptext)+length(delim);
temptext := copy(temptext,start,length(temptext));
end;
slut := pos (delim,temptext);
end;
if start >0 then
begin
if slut = 0 then slut := length(text);
result := copy (temptext,1,slut-1);
end
else
result := text;
end
elseresult := text;
end;function StringReplaceAll (text,byt,mot : string ) :string; {Funktion för att byta ut alla förekomster av en sträng mot en annan sträng in en sträng. Den konverterade strängen returneras. Om byt finns i mot måste vi gå via en temporär variant!!!} var plats : integer;
beginWhile pos(byt,text) > 0 do begin
plats := pos(byt,text);
delete (text,plats,length(byt));
insert (mot,text,plats);
end;
result := text;end; function StringReplace (text,byt,mot : string ) :string; {Funktion för att byta ut den första förekomsten av en sträng mot en annan sträng in en sträng. Den konverterade strängen returneras.} var plats : integer;
beginif pos(byt,text) > 0 then begin
plats := pos(byt,text);
delete (text,plats,length(byt));
insert (mot,text,plats);
end;
result := text;end; function hamtastreng (text,strt,slut : string):string; {Funktion för att hämta ut en delsträng ur en annan sträng. Om start och slut finns i text så returneras en sträng där start ingår i början och fram till tecknet före slut.} var stplats,slutplats : integer;
resultat : string;
beginresultat :=''; stplats := pos(strt,text); if stplats >0 then begin
text := copy (text,stplats,length(text));
slutplats := pos(slut,text);
if slutplats >0 then
begin
resultat := copy(text,1,slutplats-1);
end;
end;result := resultat; end; function hamtastrengmellan (text,strt,slut : string):string; {Funktion för att hämta ut en delsträng ur en annan sträng. Om start och slut finns i text så returneras en sträng där start ingår i början och fram till tecknet före slut.} var stplats,slutplats : integer;
resultat : string;
beginresultat :=''; stplats := pos(strt,text); if stplats >0 then begin
text := copy (text,stplats+length(strt),length(text));
slutplats := pos(slut,text);
if slutplats >0 then
begin
resultat := copy(text,1,slutplats-1);
end;
end;result := resultat; end; function endsWith (text,teststreng : string):boolean; {Kollar om en sträng slutar med en annan sträng. Returnerar true eller false.} var textlngd,testlngd : integer;
kollstreng : string;
begintestlngd := length(teststreng); textlngd := length (text); if textlngd > testlngd then begin
kollstreng := copy (text,(textlngd+1)-testlngd,testlngd);
if kollstreng = teststreng then
result := true
else
result := false;
end
elseresult := false;
end;function beginsWith (text,teststreng : string):boolean; {Funktion för att kolla om text börjar med teststreng. Returnerar true eller false.} var textlngd,testlngd : integer;
kollstreng : string;
begintestlngd := length(teststreng); textlngd := length (text); if textlngd >= testlngd then begin
kollstreng := copy (text,1,testlngd);
if kollstreng = teststreng then
result := true
else
result := false;
end
elseresult := false;
end;function sistamening(text : string) : string; //Funktion för att ta fram sista meningen i en sträng. Söker på !?. var i:integer;
begini :=length(text)-1;
while (copy(text,i,1)<> '.') and (copy(text,i,1)<> '!') and (copy(text,i,1)<> '?') do
begin
dec(i);
if i =1 then break
end;
if i>1 then
result := copy(text,i,length(text))
else
result := '';
end;Function text2sgml(text : String) : String; {Funktion som byter ut alla ovanliga tecken mot entiteter. Den färdiga texten returneras.} begin text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&');
text := stringreplaceall (text,'å','å');
text := stringreplaceall (text,'Å','Å');
text := stringreplaceall (text,'ä','ä');
text := stringreplaceall (text,'Ä','Ä');
text := stringreplaceall (text,'á','á');
text := stringreplaceall (text,'Á','Á');
text := stringreplaceall (text,'à','à');
text := stringreplaceall (text,'À','À');
text := stringreplaceall (text,'æ','æ');
text := stringreplaceall (text,'Æ','&Aelig;');
text := stringreplaceall (text,'Â','Â');
text := stringreplaceall (text,'â','â');
text := stringreplaceall (text,'ã','ã');
text := stringreplaceall (text,'Ã','Ã');
text := stringreplaceall (text,'ç','ç');
text := stringreplaceall (text,'Ç','Ç');
text := stringreplaceall (text,'é','é');
text := stringreplaceall (text,'É','É');
text := stringreplaceall (text,'ê','ê');
text := stringreplaceall (text,'Ê','Ê');
text := stringreplaceall (text,'ë','ë');
text := stringreplaceall (text,'Ë','Ë');
text := stringreplaceall (text,'è','è');
text := stringreplaceall (text,'È','È');
text := stringreplaceall (text,'î','î');
text := stringreplaceall (text,'Î','Î');
text := stringreplaceall (text,'í','í');
text := stringreplaceall (text,'Í','Í');
text := stringreplaceall (text,'ì','ì');
text := stringreplaceall (text,'Ì','Ì');
text := stringreplaceall (text,'ï','ï');
text := stringreplaceall (text,'Ï','Ï');
text := stringreplaceall (text,'ñ','ñ');
text := stringreplaceall (text,'Ñ','Ñ');
text := stringreplaceall (text,'ö','ö');
text := stringreplaceall (text,'Ö','Ö');
text := stringreplaceall (text,'ò','ò');
text := stringreplaceall (text,'Ò','Ò');
text := stringreplaceall (text,'ó','ó');
text := stringreplaceall (text,'Ó','Ó');
text := stringreplaceall (text,'ø','ø');
text := stringreplaceall (text,'Ø','Ø');
text := stringreplaceall (text,'Ô','Ô');
text := stringreplaceall (text,'ô','ô');
text := stringreplaceall (text,'õ','õ');
text := stringreplaceall (text,'Õ','Õ');
text := stringreplaceall (text,'ü','ü');
text := stringreplaceall (text,'Ü','Ü');
text := stringreplaceall (text,'ú','ú');
text := stringreplaceall (text,'Ú','Ú');
text := stringreplaceall (text,'Ù','Ù');
text := stringreplaceall (text,'ù','ù');
text := stringreplaceall (text,'û','û');
text := stringreplaceall (text,'Û','Û');
text := stringreplaceall (text,'ý','ý');
text := stringreplaceall (text,'Ý','Ý');
text := stringreplaceall (text,'ÿ','ÿ');
text := stringreplaceall (text,'|',' ');
result := text;
End;Function sgml2win(text : String) : String; {Funktion som ersätter alla entiteter mot deras tecken i windows. Den färdiga strängen returneras.} begin text := stringreplaceall (text,'á','á'); text := stringreplaceall (text,'Á','Á'); text := stringreplaceall (text,'æ','æ'); text := stringreplaceall (text,'&Aelig;','Æ'); text := stringreplaceall (text,'à','à'); text := stringreplaceall (text,'À','À'); text := stringreplaceall (text,'å','å'); text := stringreplaceall (text,'Å','Å'); text := stringreplaceall (text,'ä','ä'); text := stringreplaceall (text,'Ä','Ä'); text := stringreplaceall (text,'Â' ,'Â'); text := stringreplaceall (text,'â' ,'â'); text := stringreplaceall (text,'ã','ã'); text := stringreplaceall (text,'Ã','Ã'); text := stringreplaceall (text,'ç','ç'); text := stringreplaceall (text,'Ç','Ç'); text := stringreplaceall (text,'é','é'); text := stringreplaceall (text,'É','É'); text := stringreplaceall (text,'è','è'); text := stringreplaceall (text,'È','È'); text := stringreplaceall (text,'ê' ,'ê'); text := stringreplaceall (text,'Ê' ,'Ê'); text := stringreplaceall (text,'ë' ,'ë'); text := stringreplaceall (text,'Ë' ,'Ë'); text := stringreplaceall (text,'î' ,'î'); text := stringreplaceall (text,'Î' ,'Î'); text := stringreplaceall (text,'í','í'); text := stringreplaceall (text,'Í','Í'); text := stringreplaceall (text,'ì','ì'); text := stringreplaceall (text,'Ì','Ì'); text := stringreplaceall (text,'ï' ,'ï'); text := stringreplaceall (text,'Ï' ,'Ï'); text := stringreplaceall (text,'ñ','ñ'); text := stringreplaceall (text,'Ñ','Ñ'); text := stringreplaceall (text,'ò','ò'); text := stringreplaceall (text,'Ò','Ò'); text := stringreplaceall (text,'ó','ó'); text := stringreplaceall (text,'Ó','Ó'); text := stringreplaceall (text,'ö','ö'); text := stringreplaceall (text,'Ö','Ö'); text := stringreplaceall (text,'ø','ø'); text := stringreplaceall (text,'Ø','Ø'); text := stringreplaceall (text,'Ô' ,'Ô'); text := stringreplaceall (text,'ô' ,'ô'); text := stringreplaceall (text,'õ','õ'); text := stringreplaceall (text,'Õ','Õ'); text := stringreplaceall (text,'ü','ü'); text := stringreplaceall (text,'Ü','Ü'); text := stringreplaceall (text,'ú','ú'); text := stringreplaceall (text,'Ú','Ú'); text := stringreplaceall (text,'û' ,'û'); text := stringreplaceall (text,'Û' ,'Û'); text := stringreplaceall (text,'Ù','Ù'); text := stringreplaceall (text,'ù','ù'); text := stringreplaceall (text,'ý','ý'); text := stringreplaceall (text,'Ý','Ý'); text := stringreplaceall (text,'ÿ' ,'ÿ'); text := stringreplaceall (text,' ','|'); text := stringreplaceall (text,'&','&'); result := text; End; Function sgml2mac(text : String) : String; {Funktion som ersätter alla entiteter mot deras tecken i mac. Den färdiga strängen returneras.} begin text := stringreplaceall (text,'á',chr(135)); text := stringreplaceall (text,'Á',chr(231)); text := stringreplaceall (text,'æ',chr(190)); text := stringreplaceall (text,'&Aelig;',chr(174)); text := stringreplaceall (text,'à',chr(136)); text := stringreplaceall (text,'À',chr(203)); text := stringreplaceall (text,'å',chr(140)); text := stringreplaceall (text,'Å',chr(129)); text := stringreplaceall (text,'Ä',chr(128)); text := stringreplaceall (text,'ä',chr(138)); text := stringreplaceall (text,'Â' ,chr(229)); text := stringreplaceall (text,'â' ,chr(137)); text := stringreplaceall (text,'ã',chr(139)); text := stringreplaceall (text,'Ã',chr(204)); text := stringreplaceall (text,'ç',chr(141)); text := stringreplaceall (text,'Ç',chr(130)); text := stringreplaceall (text,'é',chr(142)); text := stringreplaceall (text,'É',chr(131)); text := stringreplaceall (text,'è',chr(143)); text := stringreplaceall (text,'È',chr(233)); text := stringreplaceall (text,'ê' ,chr(144)); text := stringreplaceall (text,'Ê' ,chr(230)); text := stringreplaceall (text,'ë' ,chr(145)); text := stringreplaceall (text,'Ë' ,chr(232)); text := stringreplaceall (text,'î' ,chr(148)); text := stringreplaceall (text,'Î' ,chr(235)); text := stringreplaceall (text,'í' ,chr(146)); text := stringreplaceall (text,'Í' ,chr(234)); text := stringreplaceall (text,'ì' ,chr(147)); text := stringreplaceall (text,'Ì' ,chr(237)); text := stringreplaceall (text,'ï' ,chr(149)); text := stringreplaceall (text,'Ï' ,chr(236)); text := stringreplaceall (text,'ñ',chr(150)); text := stringreplaceall (text,'Ñ',chr(132)); text := stringreplaceall (text,'ò',chr(152)); text := stringreplaceall (text,'Ò',chr(241)); text := stringreplaceall (text,'ó',chr(151)); text := stringreplaceall (text,'Ó',chr(238)); text := stringreplaceall (text,'Ô' ,chr(239)); text := stringreplaceall (text,'ô' ,chr(153)); text := stringreplaceall (text,'ø',chr(191)); text := stringreplaceall (text,'Ø',chr(175)); text := stringreplaceall (text,'õ',chr(155)); text := stringreplaceall (text,'Õ',chr(239)); text := stringreplaceall (text,'ö',chr(154)); text := stringreplaceall (text,'Ö',chr(133)); text := stringreplaceall (text,'ü',chr(159)); text := stringreplaceall (text,'Ü',chr(134)); text := stringreplaceall (text,'ú',chr(156)); text := stringreplaceall (text,'Ú',chr(242)); text := stringreplaceall (text,'û' ,chr(158)); text := stringreplaceall (text,'Û' ,chr(243)); text := stringreplaceall (text,'Ù',chr(244)); text := stringreplaceall (text,'ù',chr(157)); text := stringreplaceall (text,'ý','y'); text := stringreplaceall (text,'ÿ' ,chr(216)); text := stringreplaceall (text,'Ÿ' ,chr(217)); text := stringreplaceall (text,' ',' '); text := stringreplaceall (text,'&',chr(38)); result := text; End; Function sgml2rtf(text : string) : String; {Funktion för att byta ut sgml-entiteter mot de koder som gäller i RTF-textrutorna.} begin text := stringreplaceall (text,'}','#]#'); text := stringreplaceall (text,'{','#[#'); text := stringreplaceall (text,'\','HSALSKCAB'); text := stringreplaceall (text,'HSALSKCAB','\\'); text := stringreplaceall (text,'æ','\'+chr(39)+'c6'); text := stringreplaceall (text,'&Aelig;','\'+chr(39)+'e6'); text := stringreplaceall (text,'á','\'+chr(39)+'e1'); text := stringreplaceall (text,'Á','\'+chr(39)+'c1'); text := stringreplaceall (text,'à','\'+chr(39)+'e0'); text := stringreplaceall (text,'À','\'+chr(39)+'c0'); text := stringreplaceall (text,'å','\'+chr(39)+'e5'); text := stringreplaceall (text,'Å','\'+chr(39)+'c5'); text := stringreplaceall (text,'Â','\'+chr(39)+'c2'); text := stringreplaceall (text,'â','\'+chr(39)+'e2'); text := stringreplaceall (text,'ã','\'+chr(39)+'e3'); text := stringreplaceall (text,'Ã','\'+chr(39)+'c3'); text := stringreplaceall (text,'ä','\'+chr(39)+'e4'); text := stringreplaceall (text,'Ä','\'+chr(39)+'c4'); text := stringreplaceall (text,'ç','\'+chr(39)+'e7'); text := stringreplaceall (text,'Ç','\'+chr(39)+'c7'); text := stringreplaceall (text,'é','\'+chr(39)+'e9'); text := stringreplaceall (text,'É','\'+chr(39)+'c9'); text := stringreplaceall (text,'è','\'+chr(39)+'e8'); text := stringreplaceall (text,'È','\'+chr(39)+'c8'); text := stringreplaceall (text,'ê','\'+chr(39)+'ea'); text := stringreplaceall (text,'Ê','\'+chr(39)+'ca'); text := stringreplaceall (text,'ë','\'+chr(39)+'eb'); text := stringreplaceall (text,'Ë','\'+chr(39)+'cb'); text := stringreplaceall (text,'î','\'+chr(39)+'ee'); text := stringreplaceall (text,'Î','\'+chr(39)+'ce'); text := stringreplaceall (text,'í','\'+chr(39)+'ed'); text := stringreplaceall (text,'Í','\'+chr(39)+'cd'); text := stringreplaceall (text,'ì','\'+chr(39)+'ec'); text := stringreplaceall (text,'Ì','\'+chr(39)+'cc'); text := stringreplaceall (text,'ï' ,'\'+chr(39)+'ef'); text := stringreplaceall (text,'Ï' ,'\'+chr(39)+'cf'); text := stringreplaceall (text,'ñ','\'+chr(39)+'f1'); text := stringreplaceall (text,'Ñ','\'+chr(39)+'d1'); text := stringreplaceall (text,'ö','\'+chr(39)+'f6'); text := stringreplaceall (text,'Ö','\'+chr(39)+'d6'); text := stringreplaceall (text,'ó','\'+chr(39)+'f3'); text := stringreplaceall (text,'Ó','\'+chr(39)+'d3'); text := stringreplaceall (text,'ò','\'+chr(39)+'f2'); text := stringreplaceall (text,'Ò','\'+chr(39)+'d2'); text := stringreplaceall (text,'ø','\'+chr(39)+'f8'); text := stringreplaceall (text,'Ø','\'+chr(39)+'d8'); text := stringreplaceall (text,'Ô','\'+chr(39)+'d4'); text := stringreplaceall (text,'ô','\'+chr(39)+'f4'); text := stringreplaceall (text,'õ','\'+chr(39)+'f5'); text := stringreplaceall (text,'Õ','\'+chr(39)+'d5'); text := stringreplaceall (text,'ú','\'+chr(39)+'fa'); text := stringreplaceall (text,'Ú','\'+chr(39)+'da'); text := stringreplaceall (text,'û','\'+chr(39)+'fb'); text := stringreplaceall (text,'Û','\'+chr(39)+'db'); text := stringreplaceall (text,'Ù','\'+chr(39)+'d9'); text := stringreplaceall (text,'ù','\'+chr(39)+'f9'); text := stringreplaceall (text,'ü','\'+chr(39)+'fc'); text := stringreplaceall (text,'Ü','\'+chr(39)+'dc'); text := stringreplaceall (text,'ý','\'+chr(39)+'fd'); text := stringreplaceall (text,'Ý','\'+chr(39)+'dd'); text := stringreplaceall (text,'ÿ','\'+chr(39)+'ff'); text := stringreplaceall (text,'£','\'+chr(39)+'a3'); text := stringreplaceall (text,'#]#','\}'); text := stringreplaceall (text,'#[#','\{'); text := stringreplaceall (text,' ','|'); text := stringreplaceall (text,'&','&'); result := text; End; function rtf2sgml (text : string) : string; {Funktion för att konvertera en RTF-rad till SGML-text.} var temptext : string;
start : integer;
begintext := stringreplaceall (text,'&','##amp;'); text := stringreplaceall (text,'##amp','&'); text := stringreplaceall (text,'\'+chr(39)+'c6','æ'); text := stringreplaceall (text,'\'+chr(39)+'e6','&Aelig;'); text := stringreplaceall (text,'\'+chr(39)+'e5','å'); text := stringreplaceall (text,'\'+chr(39)+'c5','Å'); text := stringreplaceall (text,'\'+chr(39)+'e4','ä'); text := stringreplaceall (text,'\'+chr(39)+'c4','Ä'); text := stringreplaceall (text,'\'+chr(39)+'e1','á'); text := stringreplaceall (text,'\'+chr(39)+'c1','Á'); text := stringreplaceall (text,'\'+chr(39)+'e0','à'); text := stringreplaceall (text,'\'+chr(39)+'c0','À'); text := stringreplaceall (text,'\'+chr(39)+'c2','Â'); text := stringreplaceall (text,'\'+chr(39)+'e2','â'); text := stringreplaceall (text,'\'+chr(39)+'e3','ã'); text := stringreplaceall (text,'\'+chr(39)+'c3','Ã'); text := stringreplaceall (text,'\'+chr(39)+'e7','ç'); text := stringreplaceall (text,'\'+chr(39)+'c7','Ç'); text := stringreplaceall (text,'\'+chr(39)+'e9','é'); text := stringreplaceall (text,'\'+chr(39)+'c9','É'); text := stringreplaceall (text,'\'+chr(39)+'e8','è'); text := stringreplaceall (text,'\'+chr(39)+'c8','È'); text := stringreplaceall (text,'\'+chr(39)+'ea','ê'); text := stringreplaceall (text,'\'+chr(39)+'ca','Ê'); text := stringreplaceall (text,'\'+chr(39)+'eb','ë'); text := stringreplaceall (text,'\'+chr(39)+'cb','Ë'); text := stringreplaceall (text,'\'+chr(39)+'ee','î'); text := stringreplaceall (text,'\'+chr(39)+'ce','Î'); text := stringreplaceall (text,'\'+chr(39)+'ed','í'); text := stringreplaceall (text,'\'+chr(39)+'cd','Í'); text := stringreplaceall (text,'\'+chr(39)+'ec','ì'); text := stringreplaceall (text,'\'+chr(39)+'cc','Ì'); text := stringreplaceall (text,'\'+chr(39)+'ef','ï'); text := stringreplaceall (text,'\'+chr(39)+'cf','Ï'); text := stringreplaceall (text,'\'+chr(39)+'f1','ñ'); text := stringreplaceall (text,'\'+chr(39)+'d1','Ñ'); text := stringreplaceall (text,'\'+chr(39)+'f3','ó'); text := stringreplaceall (text,'\'+chr(39)+'d3','Ó'); text := stringreplaceall (text,'\'+chr(39)+'f2','ò'); text := stringreplaceall (text,'\'+chr(39)+'d2','Ò'); text := stringreplaceall (text,'\'+chr(39)+'d4','Ô'); text := stringreplaceall (text,'\'+chr(39)+'f4','ô'); text := stringreplaceall (text,'\'+chr(39)+'f5','õ'); text := stringreplaceall (text,'\'+chr(39)+'d5','Õ'); text := stringreplaceall (text,'\'+chr(39)+'f8','ø'); text := stringreplaceall (text,'\'+chr(39)+'d8','Ø'); text := stringreplaceall (text,'\'+chr(39)+'f6','ö'); text := stringreplaceall (text,'\'+chr(39)+'d6','Ö'); text := stringreplaceall (text,'\'+chr(39)+'fc','ü'); text := stringreplaceall (text,'\'+chr(39)+'dc','Ü'); text := stringreplaceall (text,'\'+chr(39)+'fa','ú'); text := stringreplaceall (text,'\'+chr(39)+'da','Ú'); text := stringreplaceall (text,'\'+chr(39)+'fb','û'); text := stringreplaceall (text,'\'+chr(39)+'db','Û'); text := stringreplaceall (text,'\'+chr(39)+'d9','Ù'); text := stringreplaceall (text,'\'+chr(39)+'f9','ù'); text := stringreplaceall (text,'\'+chr(39)+'fd','ý'); text := stringreplaceall (text,'\'+chr(39)+'dd','Ý'); text := stringreplaceall (text,'\'+chr(39)+'ff','ÿ'); text := stringreplaceall (text,'|',' '); text := stringreplaceall (text,'\'+chr(39)+'a3','£'); text := stringreplaceall (text,'\}','#]#'); text := stringreplaceall (text,'\{','#[#'); if (beginswith (text, '{\rtf1\')) or (beginswith (text, '{\colortbl\')) then begin
result := '';
exit;
end;
//text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort}//temptext := hamtastreng (text,'{\rtf1','{\f0');{Skall alltid tas bort} //text := stringreplace (text,temptext,''); //temptext := hamtastreng (text,'{\f0','{\f1');{Skall alltid tas bort} //text := stringreplace (text,temptext,''); //temptext := hamtastreng (text,'{\f1','{\f2');{Skall alltid tas bort} //text := stringreplace (text,temptext,''); //text := stringreplaceall (text,'{\f2\fswiss\fprq2 System;}}','');{Skall alltid tas bort} //text := stringreplaceall (text,'{\colortbl\red0\green0\blue0;}','');{Skall alltid tas bort} {I version 2.01 av Delphi finns inte \cf0 med i RTF-rutan. Tog därför bort det efter \fs16 och la istället en egen tvätt av \cf0.} //temptext := hamtastreng (text,'{\rtf1','\deflang'); //text := stringreplace (text,temptext,''); {Hämta och radera allt från start till deflang} text := stringreplaceall (text,'\cf0',''); temptext := hamtastreng (text,'\deflang','\pard');{Plocka från deflang till pard för att få } text := stringreplace (text,temptext,'');{oavsett vilken lang det är. Norska o svenska är olika} text := stringreplaceall (text,'\ltrpar',''); text := stringreplaceall (text,'\ql',''); text := stringreplaceall (text,'\ltrch',''); {Här skall vi plocka bort fs och flera olika siffror beroende på vilka alternativ vi godkänner.} //text := stringreplaceall (text,'\fs16','');{8 punkter} //text := stringreplaceall (text,'\fs20','');{10 punkter} {Nu städar vi istället bort alla tvåsiffriga fontsize.} while pos ('\fs',text) >0 do begin
//application.processmessages;
start := pos ('\fs',text);
Delete(text,start,5);
end;
while pos ('\f',text) >0 dobegin
//application.processmessages;
start := pos ('\f',text);
Delete(text,start,3);
end;
text := stringreplaceall (text,'\pard\li200-200{\*\pn\pnlvlblt\pnf1\pnindent200{\pntxtb\'+chr(39)+'b7}}\plain ','</P><UL>');text := stringreplaceall (text,'{\pntext\'+chr(39)+'b7\tab}','<LI>'); text := stringreplaceall (text, '\par <LI>','<LI>'); text := stringreplaceall (text, '\par <UL>','<UL>'); text := stringreplaceall (text,'\pard\plain ','<P>'); text := stringreplaceall (text,'\par \plain\b\ul ','</P><MELLIS>'); text := stringreplaceall (text,'\plain\b\ul ','</P><MELLIS>'); text := stringreplaceall (text,'\plain','</MELLIS>'); text := stringreplaceall (text,'\par }','</P>'); if (pos ('\par \tab ',text)>0) or (pos ('<P>\tab ',text)>0) then begin
text := stringreplaceall (text,'\par \tab ','<TR><TD>');
text := stringreplaceall (text,'<P>\tab ','<TR><TD>');
text := stringreplaceall (text,'\tab ','</TD><TD>');
end
elsebegin
text := stringreplaceall (text,'\tab ','');
end;
text := stringreplaceall (text,'\par ','</P><P>');text := stringreplaceall (text,'#]#','}'); text := stringreplaceall (text,'#[#','{'); text := stringreplaceall (text,'\\','\'); if pos('<TD>',text)>0 then text := text+'</TD></TR>'; if pos('<LI>',text)>0 then text := text+'</LI>'; result := text; end; end. |