Fórum Filtro por várias palavras-chave #60027

SET SQL DIALECT 3;

SET NAMES WIN1252;

CREATE OR ALTER PROCEDURE PRF_ALLTRIM (
    WVAR VARCHAR(8192))
RETURNS (
    R_ALLTRIM VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_COPY (
    WVAR VARCHAR(8192),
    WINI INTEGER,
    WTAM INTEGER)
RETURNS (
    R_COPY VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_DSTR (
    WSTR VARCHAR(8192),
    WTAM SMALLINT)
RETURNS (
    R_DSTR VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_LEN (
    WSTR VARCHAR(8192))
RETURNS (
    R_LEN SMALLINT)
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_LTRIM (
    WVAR VARCHAR(8192))
RETURNS (
    R_LTRIM VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_POS (
    SUB VARCHAR(8192),
    STR VARCHAR(8192))
RETURNS (
    RESULT SMALLINT)
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_QUEBRA_LINHA (
    WVAR VARCHAR(8192),
    WTAM SMALLINT)
RETURNS (
    WLIN1 VARCHAR(8192),
    WLIN2 VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_REPLACE_ALL_STR (
    WSTR VARCHAR(2048),
    OSTR VARCHAR(128),
    NSTR VARCHAR(128))
RETURNS (
    WRET VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_REPLACE_STR (
    WSUB VARCHAR(2048),
    WSTR VARCHAR(2048),
    WPOS SMALLINT)
RETURNS (
    WRET VARCHAR(4096))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_RTRIM (
    WVAR VARCHAR(8192))
RETURNS (
    R_RTRIM VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_S_RIGHT (
    WVAR VARCHAR(8192),
    WQTD INTEGER)
RETURNS (
    R_SRIGHT VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;


CREATE OR ALTER PROCEDURE PRF_SPACES (
    WQTD INTEGER)
RETURNS (
    R_SPACES VARCHAR(8192))
AS
BEGIN
  SUSPEND;
END;




/******************************************************************************/
/****                          Stored Procedures                           ****/
/******************************************************************************/

CREATE OR ALTER PROCEDURE PRF_ALLTRIM (
    WVAR VARCHAR(8192))
RETURNS (
    R_ALLTRIM VARCHAR(8192))
AS
DECLARE VARIABLE T SMALLINT;
begin
  /*
  Devolve um string sem espaços
  */
  select r_Len from prf_Len(:wvar) into :t;
  r_alltrim = ´´;
  while ((:wvar is not null) and (:t > 0)) do
  begin
    if (substring(:wvar from 1 for 1) <> ´ ´) then
      r_alltrim = :r_alltrim || substring(:wvar from 1 for 1);
    wvar = substring(:wvar from 2 for 8191);
    t = :t - 1;
  end
  suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_COPY (
    WVAR VARCHAR(8192),
    WINI INTEGER,
    WTAM INTEGER)
RETURNS (
    R_COPY VARCHAR(8192))
AS
DECLARE VARIABLE I INTEGER;
DECLARE VARIABLE J INTEGER;
DECLARE VARIABLE K INTEGER;
begin
   /*
   Copia de "WINI" "WTAM" bytes de "WVAR"
   Este recurso não é mais necessário no FB 2
   Pois já aceita o substring com variáveis
   */
   select r_Len from PRF_Len(:wvar) into :i;
   j = 1;
   k = 1;
   r_copy = ´´;
   while ((:wvar is not null) and (:i > 0) and (j <= :wtam)) do
   begin
     if (:k >= :wini) then
     begin
       r_copy = :r_copy || substring(:wvar from 1 for 1);
       j = j + 1;
     end
     wvar = substring(:wvar from 2 for 8191);
     k = :k + 1;
     i = :i - 1;
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_DSTR (
    WSTR VARCHAR(8192),
    WTAM SMALLINT)
RETURNS (
    R_DSTR VARCHAR(8192))
AS
DECLARE VARIABLE T SMALLINT;
declare variable s varchar(8192);
begin
   /*
   Devolve um string com espaços à direita até
   o tamanho "WTAM"
   */
   select r_Len from PRF_Len(:wstr) into :t;
   if (:wstr is null) then
   wstr = ´´;
   if (:t > :wtam) then
     select r_Copy from PRF_Copy(:wstr, 1, :wtam) into :r_dstr;
   else
   begin
     select r_spaces from PRF_spaces(:wtam - :t) into :s;
     r_dstr = :wstr || :s;
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_LEN (
    WSTR VARCHAR(8192))
RETURNS (
    R_LEN SMALLINT)
AS
DECLARE VARIABLE L varchar(10);
begin
   /*
   Devolve o tamanho em bytes de um string
   no FB 2 não é mais necessário
   */
   if (:wstr = ´MithBuster´) then
     r_Len = 10;
   else
   begin
     wstr  = :wstr || ´MithBuster´;
     r_Len = 0;
     l = substring(:wstr from 1 for 10);
     while (:l <> ´MithBuster´) do
     begin
       r_Len = :r_Len + 1;
       wstr  = substring(:wstr from 2);
       l     = substring(:wstr from 1 for 10);
     end
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_LTRIM (
    WVAR VARCHAR(8192))
RETURNS (
    R_LTRIM VARCHAR(8192))
AS
DECLARE VARIABLE J INTEGER;
DECLARE VARIABLE K INTEGER;
begin
   /*
   Devolve um string sem espaços à esquerda
   */
   j = 0;
   select r_Len from PRF_Len(:wvar) into :k;
   r_ltrim = ´´;
   while ((:wvar is not null) and (:k > 0)) do
   begin
     if (:j > 0) then
       r_ltrim = r_ltrim || substring(:wvar from 1 for 1);
     else
       if (substring(:wvar from 1 for 1) <> ´ ´) then
       begin
         r_ltrim = r_ltrim || substring(:wvar from 1 for 1);
         j = 1;
       end
       wvar = substring(:wvar from 2 for 8191);
       k = :k - 1;
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_POS (
    SUB VARCHAR(8192),
    STR VARCHAR(8192))
RETURNS (
    RESULT SMALLINT)
AS
DECLARE VARIABLE SUB2 VARCHAR(8192);
DECLARE VARIABLE TMP  VARCHAR(8192);
BEGIN
   /*
   Devolve a primeira posição de "SUB" dentro de "STR"
   */
   if ((Sub is null) or (Str is null)) then
   begin
     result = 0;
     exit;
   end
   Sub2   = Sub || ´¬´;
   Tmp    = ´´;
   result = 1;
   while ((Str not like Sub2) and (Str not like Tmp)) do
   begin
     Sub2    = ´_´ || Sub2;
     Tmp     = Tmp || ´_´;
     result  = :result + 1;
   end
   if (Str like Tmp) then
     result = 0;
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_QUEBRA_LINHA (
    WVAR VARCHAR(8192),
    WTAM SMALLINT)
RETURNS (
    WLIN1 VARCHAR(8192),
    WLIN2 VARCHAR(8192))
AS
declare variable wini SmallInt;
declare variable wstr char(1);
begin
   /*
   WVAR = um string supostamente maior que uma linha de impressão desejada
   WTAM = O tamanho do espaço (linha) de impressão desejada
   OBS: Quando se digitar em tela um varchar digamos de 900 bytes se for pressionado um ENTER
   Em qualquer tempo antes do final então devemos gravar "<BR>" <-- = à quebra de linha no HTML
   Então enviamos o Stringão e o tamanho e serão devolvidas linhas com até WTAM em bytes respeitando
   sempre uma quebra com espaços ou <BR>. Sem quebrar uma palavra pelo meio
   Devolve WLIN1 com o string a ser impresso e WLIN2 com o resto até que WLIN2 seja NULL 
   
   23/07/08 - TROQUEI O <BR> POR PONTO E VIRGULA ;
   */
   if (:wvar is not null) then
   begin                                 -- A variável está definida
     if ((:wtam is null) or (:wtam = 0)) then                         -- Tamamho não definido (só copia)
       wlin1 = :wvar;
     else
     begin                                                       -- Tamanho está definido
       if (substring(:wvar from 1 for 4) = ´;´) then
       begin
         wlin1 = ´´;
         wlin2 = substring(:wvar from 5 for 8188);
       end
       else
       begin
         select result from PRF_POS(´;´, :wvar) into :wini;
         if (:wini > 0) then
         begin
           if (:wini > :wtam) then
           begin
             select r_copy from PRF_COPY (:wvar, 1, :wtam) into :wlin1;
             select r_copy from PRF_COPY (:wvar, (:wtam + 1), (8192 - :wtam)) into :wlin2;
           end
           else
           begin
             select r_copy from  PRF_COPY  (:wvar, 1, (:wini - 1)) into :wlin1;
             select r_copy from  PRF_COPY  (:wvar, (:wini + 4), (8192 - (:wini + 4))) into :wlin2;
           end
         end
         else
         begin
           select r_copy from  PRF_COPY (:wvar, 1, :wtam) into :wlin1;
           select r_copy from  PRF_COPY (:wvar, (:wtam + 1), (8192 - :wtam)) into :wlin2;
         end
         select r_rtrim from PRF_rtrim (:wlin1) into :wlin1;
         select r_len   from PRF_LEN   (:wlin1) into :wini;
         if (:wini = :wtam) then
         begin
           select result from PRF_POS(´ ´, :wlin1) into :wini;
           if (:wini > 0) then
           begin
             select r_sright from PRF_s_right(:wlin1, 1) into :wstr;
             select r_len   from PRF_LEN   (:wlin1) into :wtam;
             while ((:wstr <> ´ ´) and (:wtam > 0)) do
             begin
               select r_copy from PRF_COPY(:wlin1, 1, (:wtam - 1)) into :wlin1;
               wlin2 = :wstr || :wlin2;
               select r_sright from PRF_s_right(:wlin1, 1) into :wstr;
               wtam = :wtam - 1;
             end
           end
         end
       end     -- O tamanho é superior ao solicitado (quebra foi necessária)
     end      -- O tamanho estava definido
   end       -- A variável estava definida if (:wlin2 = ´´) then
   wlin2 = null;
   if (:wlin2 is not null) then
     select r_ltrim from PRF_ltrim(:wlin2) into :wlin2;
   else
     wlin2 = null;
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_REPLACE_ALL_STR (
    WSTR VARCHAR(2048),
    OSTR VARCHAR(128),
    NSTR VARCHAR(128))
RETURNS (
    WRET VARCHAR(8192))
AS
declare variable wlen smallint;
declare variable part varchar(128);
begin
   /*
   Troca wm WSTR tudo que encontrar igual a OSTR(OLD)  por NSTR (NEW)
   */
   select r_len from PRF_len(:ostr) into :wlen;
   wret = ´´;
   while (:wstr <> ´´) do
   begin
     select r_copy from PRF_copy(:wstr, 1, :wlen) into :part;
     if (:part <> :ostr) then
     begin
       wret = :wret || substring(:wstr from 1 for 1);
       wstr = substring(:wstr from 2);
     end
     else
     begin
       wret = :wret || :nstr;
       select r_copy from PRF_copy(:wstr, :wlen + 1, 2047) into :wstr;
     end
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_REPLACE_STR (
    WSUB VARCHAR(2048),
    WSTR VARCHAR(2048),
    WPOS SMALLINT)
RETURNS (
    WRET VARCHAR(4096))
AS
declare variable wlen smallint;
declare variable wint smallint;
begin
   /*
   Troca WSUB em WSTR na posição WPOS
   */
   select r_Len from PRF_Len(:wstr) into :wint;
   if (:wint <= :wpos) then
   begin
     select r_DStr from PRF_DStr(:wstr, :wpos -1) into :wret;
     wret = :wret || :wsub;
   end
   else
   begin
     select r_Len from PRF_Len(:wsub) into :wlen;
     select r_Copy from PRF_Copy(:wstr, 1, (:wpos - 1)) into :wret;
     wret = :wret || :wsub;
     select r_Len from PRF_Len(:wret) into :wlen;
     select r_Copy from PRF_Copy(:wstr, :wlen + 1, :wint - :wlen) into :wstr;
     wret = :wret || :wstr;
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_RTRIM (
    WVAR VARCHAR(8192))
RETURNS (
    R_RTRIM VARCHAR(8192))
AS
DECLARE VARIABLE I INTEGER;
declare variable s varchar(1);
begin
   /*
   Retira os espaços à direita de um string
   */
   select r_Len from PRF_LEN(:wvar) into :i;
   if ((:i < 2) or (:wvar = ´ ´)) then
     r_rtrim = ´´;
   else
   begin
     while ((:i > 0) and (:wvar is not null)) do
     begin
       select r_Sright from PRF_S_RIGHT(:wvar, 1) into :s;
       if (:s = ´ ´) then
       begin
         select r_copy from PRF_COPY(:wvar, 1, (:i - 1)) into :wvar;
         i = :i - 1;
       end
       else
         break;
     end
     r_rtrim = :wvar;
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_S_RIGHT (
    WVAR VARCHAR(8192),
    WQTD INTEGER)
RETURNS (
    R_SRIGHT VARCHAR(8192))
AS
DECLARE VARIABLE K INTEGER;
begin
   /*
   Devolve WQTD caracteres à direita de um string
   */
   if (:wvar is not null) then
   begin
     select r_Len from PRF_LEN(:wvar) into :k;
     if (:wqtd >= :k) then
       r_sright = :wvar;
     else
       select r_Copy from PRF_COPY(:wvar, ((:k - :wqtd) + 1), :wqtd) into :r_sright;
   end
   suspend;
end
;

CREATE OR ALTER PROCEDURE PRF_SPACES (
    WQTD INTEGER)
RETURNS (
    R_SPACES VARCHAR(8192))
AS
begin
   /*
   devolve WQTD espaços em um string
   */
   r_spaces = ´´;
   while (:wqtd > 0) do
   begin
     r_spaces = r_spaces || ´ ´;
     wqtd = :wqtd - 1;
   end
   suspend;
end
;

  ------ O pedaço abaixo simula o EXPLODE do PHP -----
  if ((:PFPALAVRA is not null) and (:PFPALAVRA <> ´´)) then
  begin
    SQLWHERE = SQLWHERE || ´ and (C.MINICV IS ´||XNOT||´ NULL ´;
    SELECT RESULT FROM PRF_POS(´;´,:XAUX) INTO XPOS;
    IF (XPOS = 0) THEN
    BEGIN
      SQLWHERE = SQLWHERE || ´ ´||:PFPALANDOR||´ C.MINICV LIKE ´´¬´|| XAUX||´¬´´´;
      XAUX = ´´;
    END

    select r_ltrim from prf_ltrim(:xaux) into :xaux;
    select r_rtrim from prf_rtrim(:xaux) into :xaux;

    while (XAUX <> ´´) do
    begin
      SELECT WLIN1 FROM PRF_QUEBRA_LINHA(:XAUX, 100) INTO XAUX1ORI;
      select r_ltrim from prf_ltrim(:xaux1ORI) into :xaux1;
      select r_rtrim from prf_rtrim(:xaux1) into :xaux1;
      SQLWHERE = SQLWHERE || ´ ´||:PFPALANDOR||´ C.MINICV LIKE ´´¬´|| XAUX1||´¬´´´;

      XAUX1 = XAUX1ORI||´;´;
      SELECT WRET FROM PRF_REPLACE_ALL_STR(:XAUX, :XAUX1, ´´) INTO XAUX;
      SELECT RESULT FROM PRF_POS(´;´,:XAUX) INTO XPOS;
      IF (XPOS = 0) THEN
      BEGIN
        select r_ltrim from prf_ltrim(:xaux) into :xaux;
        select r_rtrim from prf_rtrim(:xaux) into :xaux;
        SQLWHERE = SQLWHERE || ´ ´||:PFPALANDOR||´ C.MINICV LIKE ´´¬´|| XAUX||´¬´´´;
        XAUX = ´´;
      END
    end
    SQLWHERE = SQLWHERE || ´)´;
  end