Firebird

CREATE OR ALTER PROCEDURE STR_UNRTF (
    P_SOURCE_RTF BLOB sub_type 1 segment SIZE 80)
RETURNS (
    RESULT_TEXT BLOB sub_type 1 segment SIZE 80)
AS
DECLARE variable TAGSTART INTEGER;
DECLARE variable TAGFINISH INTEGER;
DECLARE variable I INTEGER;
DECLARE variable TAGFOUND BLOB sub_type 1 segment SIZE 80;
DECLARE variable TAG_OPEN VARCHAR(255);
DECLARE variable TAG_CLOSE VARCHAR(255);
DECLARE variable CHAR_TEST VARCHAR(255);
DECLARE variable CHAR_HEX VARCHAR(255);
DECLARE variable CHAR_HEX_TO_STR VARCHAR(255);
DECLARE variable LQUOTE CHAR(1);
DECLARE variable HEXA_LEN INTEGER;
BEGIN

    tag_open = '';
    tag_close = '';
    hexa_len = 2;

    -- essa procedure retorna um texto (blob) sem a porcao de tags rtf, ex:
    -- ret=STR_UNRTF(string_rtf);   // resultado: texto sem as tags rtf
    -- Infelizmente, codigos RTFs complexos ou sujos fazem essa procedure capotar
    -- vou debugar mais tarde quando for conveniente.

    result_text='';
    lquote='''';
    p_source_rtf=TRIM(p_source_rtf);
    tag_open='{';
    tag_close='}';

    -- porem o primeiro caractere se comecar com {  ou o ultimo caracter terminar com }
    -- devera ser removido
    char_test=LEFT(p_source_rtf,CHAR_LENGTH(:tag_open));
    IF (char_test=:tag_open) THEN
        BEGIN
            p_source_rtf=SUBSTRING(p_source_rtf FROM 2 FOR CHAR_LENGTH(:p_source_rtf));
            p_source_rtf=TRIM(:p_source_rtf);
        END
    char_test=RIGHT(p_source_rtf,CHAR_LENGTH(:tag_close));
    IF (char_test=:tag_close) THEN
        BEGIN
            p_source_rtf=SUBSTRING(p_source_rtf FROM 1 FOR CHAR_LENGTH(:p_source_rtf)-CHAR_LENGTH(:tag_close));
            p_source_rtf=TRIM(:p_source_rtf);
        END

    -- Remove tudo que estiver em {tag}
    tagstart = POSITION (:tag_open, p_source_rtf);
    while (:tagstart > 0) do
    BEGIN
        tagfinish = POSITION (:tag_close, p_source_rtf, tagstart);
        IF (:tagfinish<:tagstart) THEN
            tagfinish=CHAR_LENGTH(p_source_rtf);
        tagfound = SUBSTRING (p_source_rtf FROM tagstart FOR ((tagfinish - tagstart) + 1));
        p_source_rtf = REPLACE (p_source_rtf, tagfound, '');
        tagstart = POSITION (:tag_open, p_source_rtf);
    END

    -- RTF tem \escape para caracteres especiais, ex: fabrica\'e7\'e3o = fabricacao
    -- E preciso localizar todos os escapes e troca-los pelas suas referencias Hexa->Ascii
    tag_open='\'||:lquote;
    tag_close=' ';
    tagstart = position (:tag_open, p_source_rtf);
    char_hex='';
    hexa_len=2+(char_length(tag_open));
    while (:tagstart > 0) do
        begin
            char_hex=substring(:p_source_rtf from :tagstart for hexa_len);
            char_hex_to_str='0x'||substring(char_hex from char_length(tag_open)+1);
            i=cast(:char_hex_to_str as int);
            if (i>0) then
                begin
                    char_hex_to_str=ascii_char(i);
                end
            else
                begin
                    char_hex_to_str='{'||:char_hex_to_str||'}';
                end
            p_source_rtf = replace (p_source_rtf, char_hex, char_hex_to_str);
            tagstart = position (:tag_open, p_source_rtf);
        end
    p_source_rtf=trim(p_source_rtf);

    -- RTF tem tags assim:
    -- \viewkind4\uc1\pard\sa200\sl276\slmult1\lang1046\fs20 blabla bla bla
    -- E preciso localizar essas tags e trocar por vazios

    tag_open='\';
    tag_close=' ';
    tagstart = position (:tag_open, p_source_rtf);
    while (:tagstart > 0) do
    begin
        tagfinish = position (:tag_close, p_source_rtf, tagstart);
        if (:tagfinish<:tagstart) then
            tagfinish=char_length(p_source_rtf);
            tagfound = substring (p_source_rtf from tagstart for ((tagfinish - tagstart) + 1));
            p_source_rtf = replace (p_source_rtf, tagfound, '');
            tagstart = position (:tag_open, p_source_rtf);
    end

    -- finaliza
    result_text = trim(p_source_rtf);

    suspend;

end