All pastes #1180691 Raw Edit

Strip IRC Color

public text v1 · immutable
#1180691 ·published 2008-08-21 14:17 UTC
rendered paste body
(*
  Função para retirar caracteres de cor de strings de IRC
  Eduardo Rolim(Vndmtrx) - Knal #DelphiX - [BrasNet]
  www.vindemiatrix.x-br.com
*)

Uses
 Contnrs; // Necessário para poder usar a classe TStack, que implementa uma estrutura de pilha

{
  Esta função para retirada dos caracteres de cor se baseia em um autômato construído
  para este propósito, utilizando-se dos conceitos da Máquina de Turing.

  Correção do código:
  Para que tudo ocorra da maneira correta, em vez de deletarmos diretamente na máquina
  empilhamos cada posição e seu relativo tamanho para, depois de finalizado o autômato,
  efetuarmos a deleção dos caracteres de cor, desempilhando-os.

  To-do: Corrigir a implementação do laço de repetição que ocasiona na não exclusão de um
  marcador de cor propositalmente escrito de maneira incorreta, no final da string.
  Corrigido: Substituído Laço For por Laço While para permitir teste de condições de parada
  da repetição

  To-do: Analizar a função para identificar possíveis falhas exploráveis como Overflow
  Underflow e outros tipos de ataques baseados em buffer
  Corrigido: Não houve necessidade de mudança no código pois a verificação de tamanho
  no laço While resolveu o problema da string vazia

  A Expressão pode ser entendida como: <#3 [num [num] [,[num [num]]]>
}
function TForm1.StripIRCColor(Text: String): String;

Type
  TUnitCor = packed Record
    Pos: Integer;
    Tam: Integer;
  end;

  PUnitCor = ^TUnitCor;

Var
 Str: String;
 UnitCor: PUnitCor;
 Pilha: TStack;

 I, LText: Integer; //Contador para o laço For
 Pos: Integer; //Armazenador para a posição do início do marcador de cor que iremos excluir
 Tam: Integer; //Armazenador para o tamanho do marcador de cor
 Estado: Integer; //Estado atual da máquina

begin
  //Inicialização das variáveis e objetos usados na execução do autômato
  Str := Text;
  Pos := -1;
  Tam := -1;
  Estado := 1;
  LText := Length(Str);
  Pilha := TStack.Create;

  //Início da execução do Autômato
  //For I := 1 to Length(Str) do begin
  I := 1;
  While (I <= LText) OR (Estado <> 1) do begin
    Case Estado of
      1: Begin //Estado atual: 1; Verifica caracter #3
        If Str[I] in [#3] then begin
          Pos := I;
          Tam := 1;
          Estado := 2;
          Inc(I);
        end else begin

          {
           http://www.sourcex.x-br.com/prog/artigos/ascii.html
           Todos os caracteres entre #1 e #31 são considerados caracteres de controle,
           por isto estes normalmente não aparecem em mensagens e podem ser excluídos
           sem risco à interpretação da mensagem.

           Os caracteres de 32 à 127 e os ASCII extendidos são os caracteres de input normais.
          }
          //Excluindo outros caracteres de controle simples.
          If Str[I] in [#1 .. #31] then begin 
            Pos := I;
            Tam := 1;
            Inc(I);

            //Delete(Str, Pos, Tam);
            New(UnitCor);
            UnitCor^.Pos := Pos;
            UnitCor^.Tam := Tam;
            Pilha.Push(UnitCor);
          end else begin
            Inc(I);
          end;
        end;
      end; //Fim do Estado 1

      2: Begin //Estado atual: 2; Verifica caracter <Numerico>
        If Str[I] in ['0'..'9'] then begin
          Inc(Tam);
          Estado := 3;
          Inc(I);
        end else begin
          Estado := 1;
          //Inc(I);

          //Delete(Str, Pos, Tam);
          New(UnitCor);
          UnitCor^.Pos := Pos;
          UnitCor^.Tam := Tam;
          Pilha.Push(UnitCor);
        end;
      end; //Fim do Estado 2

      3: Begin //Estado atual: 3; Verifica caracteres <Numerico> ou ","
        If Str[I] in ['0'..'9'] then begin
          Inc(Tam);
          Estado := 4;
          Inc(I);
        end else begin
          If Str[I] in [','] then begin
            Inc(Tam);
            Estado := 5;
            Inc(I);
          end else begin
            Estado := 1;
            //Inc(I);

            //Delete(Str, Pos, Tam);
            New(UnitCor);
            UnitCor^.Pos := Pos;
            UnitCor^.Tam := Tam;
            Pilha.Push(UnitCor);
          end;
        end;
      end; //Fim do Estado 3

      4: Begin //Estado Atual: 4; Verifica caracter ","
        If Str[I] in [','] then begin
          Inc(Tam);
          Estado := 5;
          Inc(I);
        end else begin
          Estado := 1;
          //Inc(I);

          //Delete(Str, Pos, Tam);
          New(UnitCor);
          UnitCor^.Pos := Pos;
          UnitCor^.Tam := Tam;
          Pilha.Push(UnitCor);
        end;
      end; //Fim Estado 4

      5: Begin //Estado Atual 5; Verifica caracter <Numerico>
        If Str[I] in ['0'..'9'] then begin
          Inc(Tam);
          Estado := 6;
          Inc(I);
        end else begin
          Estado := 1;
          Dec(Tam); //Se não houver número depois da virgula, significa que é uma vírgula normal
          //Inc(I);

          //Delete(Str, Pos, Tam);
          New(UnitCor);
          UnitCor^.Pos := Pos;
          UnitCor^.Tam := Tam;
          Pilha.Push(UnitCor);
        end;
      end; //Fim do Estado 5

      6: Begin //Estado Atual 6; Verifica caracter <Numerico>
        If Str[I] in ['0'..'9'] then begin
          Inc(Tam);
          Estado := 1;
          //Inc(I);

          //Delete(Str, Pos, Tam);
          New(UnitCor);
          UnitCor^.Pos := Pos;
          UnitCor^.Tam := Tam;
          Pilha.Push(UnitCor);
        end else begin
          Estado := 1;
          //Inc(I);

          //Delete(Str, Pos, Tam);
          New(UnitCor);
          UnitCor^.Pos := Pos;
          UnitCor^.Tam := Tam;
          Pilha.Push(UnitCor);
        end;
      end; //Fim do Estado 6

    end; //Fim do Case
  end; //Fim do laço For
  //Fim da execução do autômato e início da execução da limpeza da string

  While Pilha.Count > 0 do begin // Aqui efetuamos a limpeza na string
    UnitCor := Pilha.Pop;
    Delete(Str, UnitCor^.Pos, UnitCor^.Tam);
    Dispose(UnitCor);
  end;

  Pilha.Free;

  Result := Str;
end;