Советы по Delphi


Синтаксический анализ строки


Приведу модуль, где я собрал большое количество программ этого типа.
Имена функций и комментарии написаны на шведском языке, но тем не менее разобраться с тем, что делает код не так уж и сложно.

Например, для замены всех подстрок в тексте достаточно вызвать 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; begin
filtext := ''; //Ö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; begin
InStream := 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; begin
antal := 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; begin
traffar := 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; begin
i := 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; begin
start := 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 else
result := 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; begin
While
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; begin
if
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; begin
resultat :='';
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; begin
resultat :='';
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; begin
testlngd := 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 else
result := 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; begin
testlngd := 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 else
result := 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; begin
i :=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','&amp'); text := stringreplaceall (text,'å','&aring;'); text := stringreplaceall (text,'Å','&Aring;'); text := stringreplaceall (text,'ä','&auml;'); text := stringreplaceall (text,'Ä','&Auml;'); text := stringreplaceall (text,'á','&aacute;'); text := stringreplaceall (text,'Á','&Aacute;'); text := stringreplaceall (text,'à','&agrave;'); text := stringreplaceall (text,'À','&Agrave;'); text := stringreplaceall (text,'æ','&aelig;'); text := stringreplaceall (text,'Æ','&Aelig;'); text := stringreplaceall (text,'Â','&Acirc;'); text := stringreplaceall (text,'â','&acirc;'); text := stringreplaceall (text,'ã','&atilde;'); text := stringreplaceall (text,'Ã','&Atilde;'); text := stringreplaceall (text,'ç','&ccedil;'); text := stringreplaceall (text,'Ç','&Ccedil;'); text := stringreplaceall (text,'é','&eacute;'); text := stringreplaceall (text,'É','&Eacute;'); text := stringreplaceall (text,'ê','&ecirc;'); text := stringreplaceall (text,'Ê','&Ecirc;'); text := stringreplaceall (text,'ë','&euml;'); text := stringreplaceall (text,'Ë','&Euml;'); text := stringreplaceall (text,'è','&egrave;'); text := stringreplaceall (text,'È','&Egrave;'); text := stringreplaceall (text,'î','&icirc;'); text := stringreplaceall (text,'Î','&Icirc;'); text := stringreplaceall (text,'í','&iacute;'); text := stringreplaceall (text,'Í','&Iacute;'); text := stringreplaceall (text,'ì','&igrave;'); text := stringreplaceall (text,'Ì','&Igrave;'); text := stringreplaceall (text,'ï','&iuml;'); text := stringreplaceall (text,'Ï','&Iuml;'); text := stringreplaceall (text,'ñ','&ntilde;'); text := stringreplaceall (text,'Ñ','&Ntilde;'); text := stringreplaceall (text,'ö','&ouml;'); text := stringreplaceall (text,'Ö','&Ouml;'); text := stringreplaceall (text,'ò','&ograve;'); text := stringreplaceall (text,'Ò','&Ograve;'); text := stringreplaceall (text,'ó','&oacute;'); text := stringreplaceall (text,'Ó','&Oacute;'); text := stringreplaceall (text,'ø','&oslash;'); text := stringreplaceall (text,'Ø','&Oslash;'); text := stringreplaceall (text,'Ô','&Ocirc;'); text := stringreplaceall (text,'ô','&ocirc;'); text := stringreplaceall (text,'õ','&otilde;'); text := stringreplaceall (text,'Õ','&Otilde;'); text := stringreplaceall (text,'ü','&uuml;'); text := stringreplaceall (text,'Ü','&Uuml;'); text := stringreplaceall (text,'ú','&uacute;'); text := stringreplaceall (text,'Ú','&Uacute;'); text := stringreplaceall (text,'Ù','&Ugrave;'); text := stringreplaceall (text,'ù','&ugrave;'); text := stringreplaceall (text,'û','&ucirc;'); text := stringreplaceall (text,'Û','&Ucirc;'); text := stringreplaceall (text,'ý','&yacute;'); text := stringreplaceall (text,'Ý','&Yacute;'); text := stringreplaceall (text,'ÿ','&yuml;'); text := stringreplaceall (text,'|','&nbsp;'); 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,'&aacute;','á');
text := stringreplaceall (text,'&Aacute;','Á');
text := stringreplaceall (text,'&aelig;','æ');
text := stringreplaceall (text,'&Aelig;','Æ');
text := stringreplaceall (text,'&agrave;','à');
text := stringreplaceall (text,'&Agrave;','À');
text := stringreplaceall (text,'&aring;','å');
text := stringreplaceall (text,'&Aring;','Å');
text := stringreplaceall (text,'&auml;','ä');
text := stringreplaceall (text,'&Auml;','Ä');
text := stringreplaceall (text,'&Acirc;' ,'Â');
text := stringreplaceall (text,'&acirc;' ,'â');
text := stringreplaceall (text,'&atilde;','ã');
text := stringreplaceall (text,'&Atilde;','Ã');
text := stringreplaceall (text,'&ccedil;','ç');
text := stringreplaceall (text,'&Ccedil;','Ç');
text := stringreplaceall (text,'&eacute;','é');
text := stringreplaceall (text,'&Eacute;','É');
text := stringreplaceall (text,'&egrave;','è');
text := stringreplaceall (text,'&Egrave;','È');
text := stringreplaceall (text,'&ecirc;' ,'ê');
text := stringreplaceall (text,'&Ecirc;' ,'Ê');
text := stringreplaceall (text,'&euml;'  ,'ë');
text := stringreplaceall (text,'&Euml;'  ,'Ë');
text := stringreplaceall (text,'&icirc;' ,'î');
text := stringreplaceall (text,'&Icirc;' ,'Î');
text := stringreplaceall (text,'&iacute;','í');
text := stringreplaceall (text,'&Iacute;','Í');
text := stringreplaceall (text,'&igrave;','ì');
text := stringreplaceall (text,'&Igrave;','Ì');
text := stringreplaceall (text,'&iuml;'  ,'ï');
text := stringreplaceall (text,'&Iuml;'  ,'Ï');
text := stringreplaceall (text,'&ntilde;','ñ');
text := stringreplaceall (text,'&Ntilde;','Ñ');
text := stringreplaceall (text,'&ograve;','ò');
text := stringreplaceall (text,'&Ograve;','Ò');
text := stringreplaceall (text,'&oacute;','ó');
text := stringreplaceall (text,'&Oacute;','Ó');
text := stringreplaceall (text,'&ouml;','ö');
text := stringreplaceall (text,'&Ouml;','Ö');
text := stringreplaceall (text,'&oslash;','ø');
text := stringreplaceall (text,'&Oslash;','Ø');
text := stringreplaceall (text,'&Ocirc;' ,'Ô');
text := stringreplaceall (text,'&ocirc;' ,'ô');
text := stringreplaceall (text,'&otilde;','õ');
text := stringreplaceall (text,'&Otilde;','Õ');
text := stringreplaceall (text,'&uuml;','ü');
text := stringreplaceall (text,'&Uuml;','Ü');
text := stringreplaceall (text,'&uacute;','ú');
text := stringreplaceall (text,'&Uacute;','Ú');
text := stringreplaceall (text,'&ucirc;' ,'û');
text := stringreplaceall (text,'&Ucirc;' ,'Û');
text := stringreplaceall (text,'&Ugrave;','Ù');
text := stringreplaceall (text,'&ugrave;','ù');
text := stringreplaceall (text,'&yacute;','ý');
text := stringreplaceall (text,'&Yacute;','Ý');
text := stringreplaceall (text,'&yuml;'  ,'ÿ');
text := stringreplaceall (text,'&nbsp;','|');
text := stringreplaceall (text,'&amp;','&');
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,'&aacute;',chr(135));
text := stringreplaceall (text,'&Aacute;',chr(231));
text := stringreplaceall (text,'&aelig;',chr(190));
text := stringreplaceall (text,'&Aelig;',chr(174));
text := stringreplaceall (text,'&agrave;',chr(136));
text := stringreplaceall (text,'&Agrave;',chr(203));
text := stringreplaceall (text,'&aring;',chr(140));
text := stringreplaceall (text,'&Aring;',chr(129));
text := stringreplaceall (text,'&Auml;',chr(128));
text := stringreplaceall (text,'&auml;',chr(138));
text := stringreplaceall (text,'&Acirc;' ,chr(229));
text := stringreplaceall (text,'&acirc;' ,chr(137));
text := stringreplaceall (text,'&atilde;',chr(139));
text := stringreplaceall (text,'&Atilde;',chr(204));
text := stringreplaceall (text,'&ccedil;',chr(141));
text := stringreplaceall (text,'&Ccedil;',chr(130));
text := stringreplaceall (text,'&eacute;',chr(142));
text := stringreplaceall (text,'&Eacute;',chr(131));
text := stringreplaceall (text,'&egrave;',chr(143));
text := stringreplaceall (text,'&Egrave;',chr(233));
text := stringreplaceall (text,'&ecirc;' ,chr(144));
text := stringreplaceall (text,'&Ecirc;' ,chr(230));
text := stringreplaceall (text,'&euml;'  ,chr(145));
text := stringreplaceall (text,'&Euml;'  ,chr(232));
text := stringreplaceall (text,'&icirc;' ,chr(148));
text := stringreplaceall (text,'&Icirc;' ,chr(235));
text := stringreplaceall (text,'&iacute;' ,chr(146));
text := stringreplaceall (text,'&Iacute;' ,chr(234));
text := stringreplaceall (text,'&igrave;' ,chr(147));
text := stringreplaceall (text,'&Igrave;' ,chr(237));
text := stringreplaceall (text,'&iuml;' ,chr(149));
text := stringreplaceall (text,'&Iuml;' ,chr(236));
text := stringreplaceall (text,'&ntilde;',chr(150));
text := stringreplaceall (text,'&Ntilde;',chr(132));
text := stringreplaceall (text,'&ograve;',chr(152));
text := stringreplaceall (text,'&Ograve;',chr(241));
text := stringreplaceall (text,'&oacute;',chr(151));
text := stringreplaceall (text,'&Oacute;',chr(238));
text := stringreplaceall (text,'&Ocirc;' ,chr(239));
text := stringreplaceall (text,'&ocirc;' ,chr(153));
text := stringreplaceall (text,'&oslash;',chr(191));
text := stringreplaceall (text,'&Oslash;',chr(175));
text := stringreplaceall (text,'&otilde;',chr(155));
text := stringreplaceall (text,'&Otilde;',chr(239));
text := stringreplaceall (text,'&ouml;',chr(154));
text := stringreplaceall (text,'&Ouml;',chr(133));
text := stringreplaceall (text,'&uuml;',chr(159));
text := stringreplaceall (text,'&Uuml;',chr(134));
text := stringreplaceall (text,'&uacute;',chr(156));
text := stringreplaceall (text,'&Uacute;',chr(242));
text := stringreplaceall (text,'&ucirc;' ,chr(158));
text := stringreplaceall (text,'&Ucirc;' ,chr(243));
text := stringreplaceall (text,'&Ugrave;',chr(244));
text := stringreplaceall (text,'&ugrave;',chr(157));
text := stringreplaceall (text,'&yacute;','y');
text := stringreplaceall (text,'&yuml;'  ,chr(216));
text := stringreplaceall (text,'&Yuml;'  ,chr(217));
text := stringreplaceall (text,'&nbsp;',' ');
text := stringreplaceall (text,'&amp;',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,'&aelig;','\'+chr(39)+'c6');
text := stringreplaceall (text,'&Aelig;','\'+chr(39)+'e6');
text := stringreplaceall (text,'&aacute;','\'+chr(39)+'e1');
text := stringreplaceall (text,'&Aacute;','\'+chr(39)+'c1');
text := stringreplaceall (text,'&agrave;','\'+chr(39)+'e0');
text := stringreplaceall (text,'&Agrave;','\'+chr(39)+'c0');
text := stringreplaceall (text,'&aring;','\'+chr(39)+'e5');
text := stringreplaceall (text,'&Aring;','\'+chr(39)+'c5');
text := stringreplaceall (text,'&Acirc;','\'+chr(39)+'c2');
text := stringreplaceall (text,'&acirc;','\'+chr(39)+'e2');
text := stringreplaceall (text,'&atilde;','\'+chr(39)+'e3');
text := stringreplaceall (text,'&Atilde;','\'+chr(39)+'c3');
text := stringreplaceall (text,'&auml;','\'+chr(39)+'e4');
text := stringreplaceall (text,'&Auml;','\'+chr(39)+'c4');
text := stringreplaceall (text,'&ccedil;','\'+chr(39)+'e7');
text := stringreplaceall (text,'&Ccedil;','\'+chr(39)+'c7');
text := stringreplaceall (text,'&eacute;','\'+chr(39)+'e9');
text := stringreplaceall (text,'&Eacute;','\'+chr(39)+'c9');
text := stringreplaceall (text,'&egrave;','\'+chr(39)+'e8');
text := stringreplaceall (text,'&Egrave;','\'+chr(39)+'c8');
text := stringreplaceall (text,'&ecirc;','\'+chr(39)+'ea');
text := stringreplaceall (text,'&Ecirc;','\'+chr(39)+'ca');
text := stringreplaceall (text,'&euml;','\'+chr(39)+'eb');
text := stringreplaceall (text,'&Euml;','\'+chr(39)+'cb');
text := stringreplaceall (text,'&icirc;','\'+chr(39)+'ee');
text := stringreplaceall (text,'&Icirc;','\'+chr(39)+'ce');
text := stringreplaceall (text,'&iacute;','\'+chr(39)+'ed');
text := stringreplaceall (text,'&Iacute;','\'+chr(39)+'cd');
text := stringreplaceall (text,'&igrave;','\'+chr(39)+'ec');
text := stringreplaceall (text,'&Igrave;','\'+chr(39)+'cc');
text := stringreplaceall (text,'&iuml;'  ,'\'+chr(39)+'ef');
text := stringreplaceall (text,'&Iuml;'  ,'\'+chr(39)+'cf');
text := stringreplaceall (text,'&ntilde;','\'+chr(39)+'f1');
text := stringreplaceall (text,'&Ntilde;','\'+chr(39)+'d1');
text := stringreplaceall (text,'&ouml;','\'+chr(39)+'f6');
text := stringreplaceall (text,'&Ouml;','\'+chr(39)+'d6');
text := stringreplaceall (text,'&oacute;','\'+chr(39)+'f3');
text := stringreplaceall (text,'&Oacute;','\'+chr(39)+'d3');
text := stringreplaceall (text,'&ograve;','\'+chr(39)+'f2');
text := stringreplaceall (text,'&Ograve;','\'+chr(39)+'d2');
text := stringreplaceall (text,'&oslash;','\'+chr(39)+'f8');
text := stringreplaceall (text,'&Oslash;','\'+chr(39)+'d8');
text := stringreplaceall (text,'&Ocirc;','\'+chr(39)+'d4');
text := stringreplaceall (text,'&ocirc;','\'+chr(39)+'f4');
text := stringreplaceall (text,'&otilde;','\'+chr(39)+'f5');
text := stringreplaceall (text,'&Otilde;','\'+chr(39)+'d5');
text := stringreplaceall (text,'&uacute;','\'+chr(39)+'fa');
text := stringreplaceall (text,'&Uacute;','\'+chr(39)+'da');
text := stringreplaceall (text,'&ucirc;','\'+chr(39)+'fb');
text := stringreplaceall (text,'&Ucirc;','\'+chr(39)+'db');
text := stringreplaceall (text,'&Ugrave;','\'+chr(39)+'d9');
text := stringreplaceall (text,'&ugrave;','\'+chr(39)+'f9');
text := stringreplaceall (text,'&uuml;','\'+chr(39)+'fc');
text := stringreplaceall (text,'&Uuml;','\'+chr(39)+'dc');
text := stringreplaceall (text,'&yacute;','\'+chr(39)+'fd');
text := stringreplaceall (text,'&Yacute;','\'+chr(39)+'dd');
text := stringreplaceall (text,'&yuml;','\'+chr(39)+'ff');
text := stringreplaceall (text,'&#163;','\'+chr(39)+'a3');
text := stringreplaceall (text,'#]#','\}');
text := stringreplaceall (text,'#[#','\{');
text := stringreplaceall (text,'&nbsp;','|');
text := stringreplaceall (text,'&amp;','&');
result := text;
End;

function rtf2sgml (text : string) : string;
{Funktion för att konvertera en RTF-rad till SGML-text.}
var
temptext : string; start : integer; begin
text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&amp');
text := stringreplaceall (text,'\'+chr(39)+'c6','&aelig;');
text := stringreplaceall (text,'\'+chr(39)+'e6','&Aelig;');
text := stringreplaceall (text,'\'+chr(39)+'e5','&aring;');
text := stringreplaceall (text,'\'+chr(39)+'c5','&Aring;');
text := stringreplaceall (text,'\'+chr(39)+'e4','&auml;');
text := stringreplaceall (text,'\'+chr(39)+'c4','&Auml;');
text := stringreplaceall (text,'\'+chr(39)+'e1','&aacute;');
text := stringreplaceall (text,'\'+chr(39)+'c1','&Aacute;');
text := stringreplaceall (text,'\'+chr(39)+'e0','&agrave;');
text := stringreplaceall (text,'\'+chr(39)+'c0','&Agrave;');
text := stringreplaceall (text,'\'+chr(39)+'c2','&Acirc;');
text := stringreplaceall (text,'\'+chr(39)+'e2','&acirc;');
text := stringreplaceall (text,'\'+chr(39)+'e3','&atilde;');
text := stringreplaceall (text,'\'+chr(39)+'c3','&Atilde;');
text := stringreplaceall (text,'\'+chr(39)+'e7','&ccedil;');
text := stringreplaceall (text,'\'+chr(39)+'c7','&Ccedil;');
text := stringreplaceall (text,'\'+chr(39)+'e9','&eacute;');
text := stringreplaceall (text,'\'+chr(39)+'c9','&Eacute;');
text := stringreplaceall (text,'\'+chr(39)+'e8','&egrave;');
text := stringreplaceall (text,'\'+chr(39)+'c8','&Egrave;');
text := stringreplaceall (text,'\'+chr(39)+'ea','&ecirc;');
text := stringreplaceall (text,'\'+chr(39)+'ca','&Ecirc;');
text := stringreplaceall (text,'\'+chr(39)+'eb','&euml;');
text := stringreplaceall (text,'\'+chr(39)+'cb','&Euml;');
text := stringreplaceall (text,'\'+chr(39)+'ee','&icirc;');
text := stringreplaceall (text,'\'+chr(39)+'ce','&Icirc;');
text := stringreplaceall (text,'\'+chr(39)+'ed','&iacute;');
text := stringreplaceall (text,'\'+chr(39)+'cd','&Iacute;');
text := stringreplaceall (text,'\'+chr(39)+'ec','&igrave;');
text := stringreplaceall (text,'\'+chr(39)+'cc','&Igrave;');
text := stringreplaceall (text,'\'+chr(39)+'ef','&iuml;');
text := stringreplaceall (text,'\'+chr(39)+'cf','&Iuml;');
text := stringreplaceall (text,'\'+chr(39)+'f1','&ntilde;');
text := stringreplaceall (text,'\'+chr(39)+'d1','&Ntilde;');
text := stringreplaceall (text,'\'+chr(39)+'f3','&oacute;');
text := stringreplaceall (text,'\'+chr(39)+'d3','&Oacute;');
text := stringreplaceall (text,'\'+chr(39)+'f2','&ograve;');
text := stringreplaceall (text,'\'+chr(39)+'d2','&Ograve;');
text := stringreplaceall (text,'\'+chr(39)+'d4','&Ocirc;');
text := stringreplaceall (text,'\'+chr(39)+'f4','&ocirc;');
text := stringreplaceall (text,'\'+chr(39)+'f5','&otilde;');
text := stringreplaceall (text,'\'+chr(39)+'d5','&Otilde;');
text := stringreplaceall (text,'\'+chr(39)+'f8','&oslash;');
text := stringreplaceall (text,'\'+chr(39)+'d8','&Oslash;');
text := stringreplaceall (text,'\'+chr(39)+'f6','&ouml;');
text := stringreplaceall (text,'\'+chr(39)+'d6','&Ouml;');
text := stringreplaceall (text,'\'+chr(39)+'fc','&uuml;');
text := stringreplaceall (text,'\'+chr(39)+'dc','&Uuml;');
text := stringreplaceall (text,'\'+chr(39)+'fa','&uacute;');
text := stringreplaceall (text,'\'+chr(39)+'da','&Uacute;');
text := stringreplaceall (text,'\'+chr(39)+'fb','&ucirc;');
text := stringreplaceall (text,'\'+chr(39)+'db','&Ucirc;');
text := stringreplaceall (text,'\'+chr(39)+'d9','&Ugrave;');
text := stringreplaceall (text,'\'+chr(39)+'f9','&ugrave;');
text := stringreplaceall (text,'\'+chr(39)+'fd','&yacute;');
text := stringreplaceall (text,'\'+chr(39)+'dd','&Yacute;');
text := stringreplaceall (text,'\'+chr(39)+'ff','&yuml;');
text := stringreplaceall (text,'|','&nbsp;');
text := stringreplaceall (text,'\'+chr(39)+'a3','&#163;');
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 do
begin
//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 else
begin
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.
[000258]




Начало  Назад  Вперед



Книжный магазин