Перейти к содержимому

Фотография

Функции для парсинга строк

- - - - -

  • Авторизуйтесь для ответа в теме

#1
daimond

Отправлено 15 ���� 2008 - 05:29

daimond

    Свояк

  • Пользователи
  • 232 сообщений
[email protected] Здесь представлен модуль, в котором я разместил много методов для обработки строк. Некоторые функции поименованы по-шведски, но, может-быть, Вы сможете понять, что они делают. Вам потребуется один из методов, называющийся 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 := ''; //Oppna angiven fil och las in den try assignfile (infil,filnamn); //Koppla en textfilsvariabel till pathname reset (infil); //Oppna filen while not eof(infil) do begin //Sa lange vi inte natt slutet readln (infil,temptext); //Las in en rad filtext := filtext+temptext; //Lagg den till variabeln SGMLTEXT end; // while finally //slutligen closefile (infil); //Stang 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 for att byta ut alla forekomster av en strang mot en annan strang in en strang. Den konverterade strangen returneras. Om byt finns i mot maste vi ga via en temporar 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 for att byta ut den forsta forekomsten av en strang mot en annan strang in en strang. Den konverterade strangen 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 for att hamta ut en delstrang ur en annan strang. Om start och slut finns i text sa returneras en strang dar start ingar i borjan och fram till tecknet fore 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 for att hamta ut en delstrang ur en annan strang. Om start och slut finns i text sa returneras en strang dar start ingar i borjan och fram till tecknet fore 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 strang slutar med en annan strang. 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 for att kolla om text borjar 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 for att ta fram sista meningen i en strang. Soker pa !?. 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 fardiga texten returneras.} begin text := stringreplaceall (text,'&','##amp;'); text := stringreplaceall (text,'##amp','&amp'); text := stringreplaceall (text,'a','&aring;'); text := stringreplaceall (text,'A','&Aring;'); text := stringreplaceall (text,'a','&auml;'); text := stringreplaceall (text,'A','&Auml;'); text := stringreplaceall (text,'a','&aacute;'); text := stringreplaceall (text,'A','&Aacute;'); text := stringreplaceall (text,'a','&agrave;'); text := stringreplaceall (text,'A','&Agrave;'); text := stringreplaceall (text,'?','&aelig;'); text := stringreplaceall (text,'?','&Aelig;'); text := stringreplaceall (text,'A','&Acirc;'); text := stringreplaceall (text,'a','&acirc;'); text := stringreplaceall (text,'a','&atilde;'); text := stringreplaceall (text,'A','&Atilde;'); text := stringreplaceall (text,'c','&ccedil;'); text := stringreplaceall (text,'C','&Ccedil;'); text := stringreplaceall (text,'e','&eacute;'); text := stringreplaceall (text,'E','&Eacute;'); text := stringreplaceall (text,'e','&ecirc;'); text := stringreplaceall (text,'E','&Ecirc;'); text := stringreplaceall (text,'e','&euml;'); text := stringreplaceall (text,'E','&Euml;'); text := stringreplaceall (text,'e','&egrave;'); text := stringreplaceall (text,'E','&Egrave;'); text := stringreplaceall (text,'i','&icirc;'); text := stringreplaceall (text,'I','&Icirc;'); text := stringreplaceall (text,'i','&iacute;'); text := stringreplaceall (text,'I','&Iacute;'); text := stringreplaceall (text,'i','&igrave;'); text := stringreplaceall (text,'I','&Igrave;'); text := stringreplaceall (text,'i','&iuml;'); text := stringreplaceall (text,'I','&Iuml;'); text := stringreplaceall (text,'n','&ntilde;'); text := stringreplaceall (text,'N','&Ntilde;'); text := stringreplaceall (text,'o','&ouml;'); text := stringreplaceall (text,'O','&Ouml;'); text := stringreplaceall (text,'o','&ograve;'); text := stringreplaceall (text,'O','&Ograve;'); text := stringreplaceall (text,'o','&oacute;'); text := stringreplaceall (text,'O','&Oacute;'); text := stringreplaceall (text,'o','&oslash;'); text := stringreplaceall (text,'O','&Oslash;'); text := stringreplaceall (text,'O','&Ocirc;'); text := stringreplaceall (text,'o','&ocirc;'); text := stringreplaceall (text,'o','&otilde;'); text := stringreplaceall (text,'O','&Otilde;'); text := stringreplaceall (text,'u','&uuml;'); text := stringreplaceall (text,'U','&Uuml;'); text := stringreplaceall (text,'u','&uacute;'); text := stringreplaceall (text,'U','&Uacute;'); text := stringreplaceall (text,'U','&Ugrave;'); text := stringreplaceall (text,'u','&ugrave;'); text := stringreplaceall (text,'u','&ucirc;'); text := stringreplaceall (text,'U','&Ucirc;'); text := stringreplaceall (text,'y','&yacute;'); text := stringreplaceall (text,'Y','&Yacute;'); text := stringreplaceall (text,'y','&yuml;'); text := stringreplaceall (text,'|','&nbsp;'); result := text; End; Function sgml2win(text : String) : String; {Funktion som ersatter alla entiteter mot deras tecken i windows. Den fardiga strangen returneras.} begin text := stringreplaceall (text,'&aacute;','a'); text := stringreplaceall (text,'&Aacute;','A'); text := stringreplaceall (text,'&aelig;','?'); text := stringreplaceall (text,'&Aelig;','?'); text := stringreplaceall (text,'&agrave;','a'); text := stringreplaceall (text,'&Agrave;','A'); text := stringreplaceall (text,'&aring;','a'); text := stringreplaceall (text,'&Aring;','A'); text := stringreplaceall (text,'&auml;','a'); text := stringreplaceall (text,'&Auml;','A'); text := stringreplaceall (text,'&Acirc;' ,'A'); text := stringreplaceall (text,'&acirc;' ,'a'); text := stringreplaceall (text,'&atilde;','a'); text := stringreplaceall (text,'&Atilde;','A'); text := stringreplaceall (text,'&ccedil;','c'); text := stringreplaceall (text,'&Ccedil;','C'); text := stringreplaceall (text,'&eacute;','e'); text := stringreplaceall (text,'&Eacute;','E'); text := stringreplaceall (text,'&egrave;','e'); text := stringreplaceall (text,'&Egrave;','E'); text := stringreplaceall (text,'&ecirc;' ,'e'); text := stringreplaceall (text,'&Ecirc;' ,'E'); text := stringreplaceall (text,'&euml;' ,'e'); text := stringreplaceall (text,'&Euml;' ,'E'); text := stringreplaceall (text,'&icirc;' ,'i'); text := stringreplaceall (text,'&Icirc;' ,'I'); text := stringreplaceall (text,'&iacute;','i'); text := stringreplaceall (text,'&Iacute;','I'); text := stringreplaceall (text,'&igrave;','i'); text := stringreplaceall (text,'&Igrave;','I'); text := stringreplaceall (text,'&iuml;' ,'i'); text := stringreplaceall (text,'&Iuml;' ,'I'); text := stringreplaceall (text,'&ntilde;','n'); text := stringreplaceall (text,'&Ntilde;','N'); text := stringreplaceall (text,'&ograve;','o'); text := stringreplaceall (text,'&Ograve;','O'); text := stringreplaceall (text,'&oacute;','o'); text := stringreplaceall (text,'&Oacute;','O'); text := stringreplaceall (text,'&ouml;','o'); text := stringreplaceall (text,'&Ouml;','O'); text := stringreplaceall (text,'&oslash;','o'); text := stringreplaceall (text,'&Oslash;','O'); text := stringreplaceall (text,'&Ocirc;' ,'O'); text := stringreplaceall (text,'&ocirc;' ,'o'); text := stringreplaceall (text,'&otilde;','o'); text := stringreplaceall (text,'&Otilde;','O'); text := stringreplaceall (text,'&uuml;','u'); text := stringreplaceall (text,'&Uuml;','U'); text := stringreplaceall (text,'&uacute;','u'); text := stringreplaceall (text,'&Uacute;','U'); text := stringreplaceall (text,'&ucirc;' ,'u'); text := stringreplaceall (text,'&Ucirc;' ,'U'); text := stringreplaceall (text,'&Ugrave;','U'); text := stringreplaceall (text,'&ugrave;','u'); text := stringreplaceall (text,'&yacute;','y'); text := stringreplaceall (text,'&Yacute;','Y'); text := stringreplaceall (text,'&yuml;' ,'y'); text := stringreplaceall (text,'&nbsp;','|'); text := stringreplaceall (text,'&amp;','&'); result := text; End; Function sgml2mac(text : String) : String; {Funktion som ersatter alla entiteter mot deras tecken i mac. Den fardiga strangen 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 for att byta ut sgml-entiteter mot de koder som galler 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,'£','\'+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 for 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','£'); 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 darfor bort det efter \fs16 och la istallet en egen tvatt av \cf0.} //temptext := hamtastreng (text,'{\rtf1','\deflang'); //text := stringreplace (text,temptext,''); {Hamta och radera allt fran start till deflang} text := stringreplaceall (text,'\cf0',''); temptext := hamtastreng (text,'\deflang','\pard'); {Plocka fran deflang till pard for att fa } text := stringreplace (text,temptext,'');{oavsett vilken lang det ar. Norska o svenska ar olika} text := stringreplaceall (text,'\ltrpar',''); text := stringreplaceall (text,'\ql',''); text := stringreplaceall (text,'\ltrch',''); {Har skall vi plocka bort fs och flera olika siffror beroende pa vilka alternativ vi godkanner.} //text := stringreplaceall (text,'\fs16','');{8 punkter} //text := stringreplaceall (text,'\fs20','');{10 punkter} {Nu stadar vi istallet bort alla tvasiffriga 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. И еще: Как перевести RTF в HTML? Здесь процедура, которую я использую для конвертации содержимого RichEdit в код SGML. Она не создает полноценный HTML-файл, но Вы можете расширить функциональность, указал, какие RTF-коды Вы желаете конвертировать в какие-либо HTML-тэги. function rtf2sgml (text : string) : string; {Funktion for 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)+'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)+'f6','&ouml;'); text := stringreplaceall (text,'\'+chr(39)+'d6','&Ouml;'); text := stringreplaceall (text,'\'+chr(39)+'e9','&eacute;'); text := stringreplaceall (text,'\'+chr(39)+'c9','&Eacute;'); 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)+'f2','&ograve;'); text := stringreplaceall (text,'\'+chr(39)+'d2','&Ograve;'); text := stringreplaceall (text,'\'+chr(39)+'fc','&uuml;'); text := stringreplaceall (text,'\'+chr(39)+'dc','&Uuml;'); text := stringreplaceall (text,'\'+chr(39)+'a3','£'); text := stringreplaceall (text,'\}','#]#'); text := stringreplaceall (text,'\{','#[#'); text := stringreplaceall (text,'{\rtf1\ansi\deff0\deftab720',''); {Skall alltid tas bort} text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort} text := stringreplaceall (text,'{\f0\fnil MS Sans Serif;}',''); {Skall alltid tas bort} text := stringreplaceall (text,'{\f1\fnil\fcharset2 Symbol;}',''); {Skall alltid tas bort} 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 darfor bort det efter \fs16 och la istallet en egen tvatt av \cf0.} //temptext := hamtastreng (text,'{\rtf1','\deflang'); //text := stringreplace (text,temptext,''); {Hamta och radera allt fran start till deflang} text := stringreplaceall (text,'\cf0',''); temptext := hamtastreng (text,'\deflang','\pard'); {Plocka fran deflang till pard for att fa } text := stringreplace (text,temptext,''); {oavsett vilken lang det ar. Norska o svenska ar olika} {Har skall vi plocka bort fs och flera olika siffror beroende pa vilka alternativ vi godkanner.} //text := stringreplaceall (text,'\fs16','');{8 punkter} //text := stringreplaceall (text,'\fs20','');{10 punkter} {Nu stadar vi istallet bort alla tvasiffriga fontsize.} while pos ('\fs',text) >0 do begin application.processmessages; start := pos ('\fs',text); Delete(text,start,5); end; text := stringreplaceall (text,'\pard\plain\f0 ','<P>'); text := stringreplaceall (text,'\par \plain\f0\b\ul ', '</P><MELLIS>'); text := stringreplaceall (text,'\plain\f0\b\ul ', '</P><MELLIS>'); text := stringreplaceall (text,'\plain\f0','</MELLIS>'); text := stringreplaceall (text,'\par }','</P>'); text := stringreplaceall (text,'\par ','</P><P>'); text := stringreplaceall (text,'#]#','}'); text := stringreplaceall (text,'#[#','{'); text := stringreplaceall (text,'\\','\'); result := text; end; // This is cut directly from the middle of a fairly // long save routine that calls the // above function. I know I could use streams // instead of going through a separate // file but I have not had the time to change this utfilnamn := mditted.exepath+stringreplace(stringreplace( extractfilename(pathname),'.TTT',''),'.ttt','') + 'ut.RTF'; brodtext.lines.savetofile (utfilnamn); temptext := ''; assignfile(tempF,utfilnamn); reset (tempF); try while not eof(tempF) do begin readln (tempF,temptext2); temptext2 := stringreplaceall (temptext2,'\'+ chr(39)+'b6',''); temptext2 := rtf2sgml (temptext2); if temptext2 <>'' then temptext := temptext+ temptext2; application.processmessages; end; finally closefile (tempF); end; deletefile (utfilnamn); temptext := stringreplaceall (temptext,'</MELLIS> ', '</MELLIS>'); temptext := stringreplaceall (temptext,'</P> ', '</P>'); temptext := stringreplaceall (temptext,'</P>'+chr(0), '</P>'); temptext := stringreplaceall (temptext,'</MELLIS> </P>','</MELLIS>'); temptext := stringreplaceall (temptext,'<P>< /P>',''); temptext := stringreplaceall (temptext, '</P><P></MELLIS>','</MELLIS> <P>'); temptext := stringreplaceall (temptext,'</MELLIS>', '<#MELLIS><P>'); temptext := stringreplaceall (temptext,'<#MELLIS>', '</MELLIS>'); temptext := stringreplaceall (temptext,'<P>< P>','<P>'); temptext := stringreplaceall (temptext,'<P> ','< P>'); temptext := stringreplaceall (temptext,'<P>-','< P>_'); temptext := stringreplaceall (temptext,'<P>_','< CITAT>_'); while pos('<CITAT>_',temptext)>0 do begin application.processmessages; temptext2 := hamtastreng (temptext,'<CITAT>_','</P>'); temptext := stringreplace (temptext,temptext2+'</P> ',temptext2+'</CITAT>'); temptext := stringreplace (temptext,'<CITAT>_', '<CITAT>-'); end; writeln (F,'<BRODTEXT>'+temptext+'</BRODTEXT>');