Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Функции для парсинга строк

Здесь представлен модуль, в котором я разметил много методов для подобной работы. Некоторые функции поименованы по-шведски, но, может быть, Вы сможете понять, что они делают.

Вам потребуется один из методов, называющийся 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
    //Sa lange vi inte natt slutet
    while not eof(infil) do
    begin
      readln (infil,temptext); //Las in en rad
      filtext := filtext+temptext; //Lagg den till variabeln SGMLTEXT
    end;
  finally
    closefile (infil); //Stang filen
  end;
  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
    if soktext = copy(orgtext,i,soklengd) then
      traffar := traffar +1;
  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
      resultat := copy(text,1,slutplats-1);
  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
      resultat := copy(text,1,slutplats-1);
  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','&');
  text := stringreplaceall (text,'a','å');
  text := stringreplaceall (text,'A','Å');
  text := stringreplaceall (text,'a','ä');
  text := stringreplaceall (text,'A','Ä');
  text := stringreplaceall (text,'a','á');
  text := stringreplaceall (text,'A','Á');
  text := stringreplaceall (text,'a','à');
  text := stringreplaceall (text,'A','À');
  text := stringreplaceall (text,'?','æ');
  text := stringreplaceall (text,'?','&Aelig;');
  text := stringreplaceall (text,'A','Â');
  text := stringreplaceall (text,'a','â');
  text := stringreplaceall (text,'a','ã');
  text := stringreplaceall (text,'A','Ã');
  text := stringreplaceall (text,'c','ç');
  text := stringreplaceall (text,'C','Ç');
  text := stringreplaceall (text,'e','é');
  text := stringreplaceall (text,'E','É');
  text := stringreplaceall (text,'e','ê');
  text := stringreplaceall (text,'E','Ê');
  text := stringreplaceall (text,'e','ë');
  text := stringreplaceall (text,'E','Ë');
  text := stringreplaceall (text,'e','è');
  text := stringreplaceall (text,'E','È');
  text := stringreplaceall (text,'i','î');
  text := stringreplaceall (text,'I','Î');
  text := stringreplaceall (text,'i','í');
  text := stringreplaceall (text,'I','Í');
  text := stringreplaceall (text,'i','ì');
  text := stringreplaceall (text,'I','Ì');
  text := stringreplaceall (text,'i','ï');
  text := stringreplaceall (text,'I','Ï');
  text := stringreplaceall (text,'n','ñ');
  text := stringreplaceall (text,'N','Ñ');
  text := stringreplaceall (text,'o','ö');
  text := stringreplaceall (text,'O','Ö');
  text := stringreplaceall (text,'o','ò');
  text := stringreplaceall (text,'O','Ò');
  text := stringreplaceall (text,'o','ó');
  text := stringreplaceall (text,'O','Ó');
  text := stringreplaceall (text,'o','ø');
  text := stringreplaceall (text,'O','Ø');
  text := stringreplaceall (text,'O','Ô');
  text := stringreplaceall (text,'o','ô');
  text := stringreplaceall (text,'o','õ');
  text := stringreplaceall (text,'O','Õ');
  text := stringreplaceall (text,'u','ü');
  text := stringreplaceall (text,'U','Ü');
  text := stringreplaceall (text,'u','ú');
  text := stringreplaceall (text,'U','Ú');
  text := stringreplaceall (text,'U','Ù');
  text := stringreplaceall (text,'u','ù');
  text := stringreplaceall (text,'u','û');
  text := stringreplaceall (text,'U','Û');
  text := stringreplaceall (text,'y','ý');
  text := stringreplaceall (text,'Y','Ý');
  text := stringreplaceall (text,'y','ÿ');
  text := stringreplaceall (text,'|',' ');
  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,'á','a');
  text := stringreplaceall (text,'Á','A');
  text := stringreplaceall (text,'æ','?');
  text := stringreplaceall (text,'&Aelig;','?');
  text := stringreplaceall (text,'à','a');
  text := stringreplaceall (text,'À','A');
  text := stringreplaceall (text,'å','a');
  text := stringreplaceall (text,'Å','A');
  text := stringreplaceall (text,'ä','a');
  text := stringreplaceall (text,'Ä','A');
  text := stringreplaceall (text,'Â' ,'A');
  text := stringreplaceall (text,'â' ,'a');
  text := stringreplaceall (text,'ã','a');
  text := stringreplaceall (text,'Ã','A');
  text := stringreplaceall (text,'ç','c');
  text := stringreplaceall (text,'Ç','C');
  text := stringreplaceall (text,'é','e');
  text := stringreplaceall (text,'É','E');
  text := stringreplaceall (text,'è','e');
  text := stringreplaceall (text,'È','E');
  text := stringreplaceall (text,'ê' ,'e');
  text := stringreplaceall (text,'Ê' ,'E');
  text := stringreplaceall (text,'ë' ,'e');
  text := stringreplaceall (text,'Ë' ,'E');
  text := stringreplaceall (text,'î' ,'i');
  text := stringreplaceall (text,'Î' ,'I');
  text := stringreplaceall (text,'í','i');
  text := stringreplaceall (text,'Í','I');
  text := stringreplaceall (text,'ì','i');
  text := stringreplaceall (text,'Ì','I');
  text := stringreplaceall (text,'ï' ,'i');
  text := stringreplaceall (text,'Ï' ,'I');
  text := stringreplaceall (text,'ñ','n');
  text := stringreplaceall (text,'Ñ','N');
  text := stringreplaceall (text,'ò','o');
  text := stringreplaceall (text,'Ò','O');
  text := stringreplaceall (text,'ó','o');
  text := stringreplaceall (text,'Ó','O');
  text := stringreplaceall (text,'ö','o');
  text := stringreplaceall (text,'Ö','O');
  text := stringreplaceall (text,'ø','o');
  text := stringreplaceall (text,'Ø','O');
  text := stringreplaceall (text,'Ô' ,'O');
  text := stringreplaceall (text,'ô' ,'o');
  text := stringreplaceall (text,'õ','o');
  text := stringreplaceall (text,'Õ','O');
  text := stringreplaceall (text,'ü','u');
  text := stringreplaceall (text,'Ü','U');
  text := stringreplaceall (text,'ú','u');
  text := stringreplaceall (text,'Ú','U');
  text := stringreplaceall (text,'û' ,'u');
  text := stringreplaceall (text,'Û' ,'U');
  text := stringreplaceall (text,'Ù','U');
  text := stringreplaceall (text,'ù','u');
  text := stringreplaceall (text,'ý','y');
  text := stringreplaceall (text,'Ý','Y');
  text := stringreplaceall (text,'ÿ' ,'y');
  text := stringreplaceall (text,' ','|');
  text := stringreplaceall (text,'&','&');
  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,'á',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 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,'æ','\'+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 for att konvertera en RTF-rad till SGML-text.}
var
  temptext : string;
  start : integer;
begin
  text := 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 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
    text := stringreplaceall (text,'\tab ','');
  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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.