Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  166

•  TDictionary Custom Sort  3 340

•  Fast Watermark Sources  3 093

•  3D Designer  4 849

•  Sik Screen Capture  3 348

•  Patch Maker  3 554

•  Айболит (remote control)  3 664

•  ListBox Drag & Drop  3 016

•  Доска для игры Реверси  81 717

•  Графические эффекты  3 946

•  Рисование по маске  3 250

•  Перетаскивание изображений  2 631

•  Canvas Drawing  2 754

•  Рисование Луны  2 584

•  Поворот изображения  2 191

•  Рисование стержней  2 169

•  Paint on Shape  1 569

•  Генератор кроссвордов  2 239

•  Головоломка Paletto  1 767

•  Теорема Монжа об окружностях  2 232

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 057

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 219

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 366

•  HEX View  1 497

•  Физический маятник  1 358

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

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



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

Вам потребуется один из методов, называющийся 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.





Похожие по теме исходники

Линейная интерполяция функции

Нейросеть для распознавания образов

Механизм станка качалки для нефти

Весы для взвешивания

 

Кувшины для воды

Доска для игры Реверси




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте