Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

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 := '';
  //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.

Программный код на языке Pascal, который предлагает набор функций для конвертации между разными форматами кодирования специальных символов в текстовых данных, конкретно между SGML (Стандартный обобщенный язык разметки), RTF (Расширенный текстовый формат) и HTML (Язык гипертекстовой разметки).

Разбивка кода:

  1. Первая секция определяет три функции конвертации: sgml2win, sgml2mac и rtf2sgml. Эти функции принимают входной строку в формате SGML и конвертируют ее в форматы Windows, Macintosh или RTF соответственно.
  2. Вторая секция предлагает набор вспомогательных функций для манипуляции строками, таких как заменить все вхождения подстроки на другую подстроку (stringreplaceall), найти позицию подстроки в строке (pos) и удалить подстроку из строки (Delete).
  3. Третья секция реализует функции конвертации sgml2win, sgml2mac и rtf2sgml.

  4. sgml2win: Функция конвертирует текст SGML в формат Windows, заменяя специальные символы на соответствующие коды Windows.

  5. sgml2mac: Функция конвертирует текст SGML в формат Macintosh, заменяя специальные символы на соответствующие коды Macintosh.
  6. rtf2sgml: Функция конвертирует текст RTF в формат SGML, парсинг RTF-код и конвертируя его в строку в формате SGML.

Код включает несколько вспомогательных функций для манипуляции строками:

  • hamtastreng: Функция находит все вхождения подстроки в строке.
  • stringreplaceall: Функция заменяет все вхождения подстроки на другую подстроку.
  • Delete: Функция удаляет подстроку из строки.

Код также включает несколько констант и переменных:

  • temptext: Временная строковая переменная, используемая для промежуточной обработки.
  • start: Целочисленная переменная, используемая для хранения позиции подстроки в строке.
  • result: Возвращаемая строка, возвращаемая каждой функцией конвертации.

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

It seems like you're trying to convert SGML (Simple Generalized Markup Language, an older version of XML) to RTF (Rich Text Format) and vice versa. These conversions involve complex string manipulation, which can be tricky. Here's a brief explanation of


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Текст и Строки ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 11:37:16/0.0074150562286377/1