VsScripter - Exemplo de validação de números de documentos e siglas de estado

uses
   uFrmValidaNumDoc;
   
var
  formulario: TFrmValidaNumeracaoDocumentos;
  
begin
  formulario := TFrmValidaNumeracaoDocumentos.Create(nil);
  
  try
      if formulario.ShowModal = MrOk then
      begin
      end;
  
  finally
     formulario.free;    
  end;
end;

{$FORM TfrmValidaNumeracaoDocumentos, uFrmValidaNumDoc.sfm}
                                                            
uses
   // Carregando as units necessárias para o funcionamento do script
   Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
   
{ função TrocaString funciona trocando um caracter por outro (quem), dentro de
  string (onde), pelo novo caractere (porquem).
  Exemplo de uso:

    TrocaString('String de testes.', '.', '!')
    
  Resultado: trocará o ponto final pelo sinal de exclamação}
function TrocaString(onde, quem, porquem: String): String;
var
   x: Integer;
   nStr: String;
Begin                   
   nStr := '';               
   for x:=1 to length(onde) do
   begin
     if copy(onde, x, 1) <> quem then
        nStr := nStr + copy(onde, x, 1)
     else                          
        nStr := nStr + porquem;
   end;
   Result := nStr;
end;

// função DVcnpj calcula e retorna os dígitos verificadores do CNPJ, a partir do
// número do CNPJ sem os dígitos verificadores
function DVcnpj(CNPJ: string): string;
var                                               
  Num, Soma, Dig : Integer;
  mult, X, Tam: Byte;
begin
  Result := '';
  for Tam := 12 TO 13 do
  begin
    CNPJ := Copy(CNPJ, 1, Tam);
    mult := 1;
    Soma := 0;
    for X := Length(CNPJ) DownTo 1 do
    begin
      if mult = 9 then mult := 2
                  else Inc(mult);
      Num := StrToInt( CNPJ[X] );
      Soma := Soma + (Num * mult);
    end;
    Dig := (Soma*10) mod 11;
    if Dig > 9 then Dig := 0; 
    Result := Result + IntToStr(Dig);
    CNPJ := CNPJ + Result;
  end;
end; 

// função DVcpf calcula e retorna os digitos verificadores para o CPF, a partir
// do numero do CPF sem os digitos 
function DVcpf(CPF: string): string;
var                                                                                                    
  Num, Soma: Integer;
  mult, Dig, X, Tam: Byte;
begin
  Result := '';
  for Tam := 9 to 10 do
  begin
    CPF := Copy(CPF, 1, Tam);
    mult := 1;
    Soma := 0;
    for x := Length(CPF) DownTo 1 do
    begin                                                    
      Inc(mult);
      Num := StrToIntDef(CPF[X], 0);
      Soma := Soma + (Num * mult);
    end;              
    dig := (Soma*10) mod 11;
    if Dig > 9 then Dig := 0;
    Result := Result + IntToStr(Dig);
    CPF := CPF + Result;
  end;
end;

// função ChecaEstado verifica se a sigla informada faz parte da constante Estados.
// Se for, indica que é uma sigla válida.
function ChecaEstado(cUF: string): String;
{Checa se o Simbolo da UF é Valido}
const
  Estados = '|SP|MG|RJ|RS|SC|PR|ES|DF|MT|MS|GO|TO|BA|SE|AL|PB|PE|MA|RN|CE|PI|PA|AM|AP|FN|AC|RR|RO|';
begin
  Result := '';
  if Pos('|'+ UpperCase(cUF) +'|', Estados) > 0 then
     Result := 'Estado válido'
  else
     Result := Format('%s não é uma sigla de estado válida', [cUF]);
end; 

{ função SoNumeros retorna apenas os números em uma String. Neste exemplo, remove
  os sinais de formatação das máscaras do CPF, do CNPJ e do PIS. Os parâmetros são a String 
  que deve ter seu conteúdo, diferente de números, removido e o parâmetro lConsiderarZero
  que irá considerar os zeros a esquerda, sendo este do tipo boolean, que receberá 
  ou o valor True (verdadeiro) ou o valor False (falso).
  Exemplo de uso:

    SoNumeros('95.551.365/0001-10', true);
    
  Resultado: 95551365000110
}
function SoNumeros(Texto: String; lConsiderarZero: Boolean): String;
var
  c: Integer;
  sTexto: String;
begin
  sTexto := (Texto);
  Result := '';
  for c := 1 to Length(sTexto) do
    begin
    if (Ord(sTexto[c]) >= 48) AND (Ord(sTexto[c]) <= 57) then
      Result := Result + sTexto[c];                                      
  end;
  if (not lConsiderarZero) then
    begin
    while (Length(Result) > 0) do
      begin
      if (Result[1] = '0') then
        Delete(Result, 1, 1)
      else
        { Ao encontrar o primeiro caractere diferente de zero sai do loop. }
        break;
    end;
  end;
end;


{  função ValidaPis verifica se o número do PIS informado é válido ou não, sendo
   o retorno da função do tipo boolean, que retornará ou o valor True (verdadeiro)
   ou o valor False (falso), de acordo com a validade do número informado.

   Exemplo de uso:

   if ValidaPis('083.28929.56-0') then
      ShowMessage('PIS válido')
   else
      ShowMessage('PIS inválido');
}
function ValidaPis(Dado: string): boolean;
var
  i, wsoma, Wm11, Wdv, wdigito : Integer;
begin
  Dado := SoNumeros(Dado, true);
  Result := ( Length(Dado) = 11 ); {Menos de 11 digitos = invalido}
  if Result Then
  begin
    wdv := StrToInt(Dado[11]);
    wsoma := 0;
    wm11 := 2;
    for i := 1 to 10 do
      begin
      wsoma := wsoma + (wm11 * StrToInt(Dado[11-I]) );
      if wm11 < 9 then
        inc(wm11)
      else
        wm11 := 2;
    end;
    wdigito := 11 - (wsoma MOD 11);
    if wdigito > 9 then
      wdigito := 0;
    Result := (wdv = wdigito);
  end;
end;

{ função TodosCaracteresIguais verifica se o <cText> informado eh formado por
  todos os caracteres iguais, ou seja, Retorna True se cText = '1111111', '22222',
  'AAAAA', etc. Util na verificacao de CNPJ e CPF que nao aceitam numeros repetidos
}
function TodosCaracteresIguais(cText: string): Boolean;
var
  cAux: string;
begin
  //obtém o 1o. caractere da string
  cAux := Copy(cText, 1, 1);
  cAux := TrocaString(cText, cAux, '')   
  // Se nao sobrou nada em cAux, significa que todos os demais caracteres eram
  // iguais ao primeiro
  Result := (Trim(cAux) = '');                 
end;

{   função ValCNPJ Retorna True se o número do CNPJ for válido. Se CheckDupChar
    for igual True, não aceita CNPJ composto por todos os números repetidos,
    como, 11111111111111, 22222222222222, etc. Se CheckDupChar for False, irá
    aceitar tais números.}
function ValCNPJ(cCNPJ: string; CheckDupChar: Boolean): Boolean;
begin
  Result := '';
  if ((not CheckDupChar) or (not TodosCaracteresIguais(cCNPJ))) and
     (Copy(cCNPJ, 13, 2) = DVcnpj(cCNPJ)) then
     Result := 'CNPJ válido!'
  else
     Result := 'CNPJ inválido!'
end;           

{  função ValCPF Retorna True se o número do CPF for válido.  Se CheckDupChar for
   igual True, não aceita CPF composto por todos os números repetidos, como,
   11111111111, 22222222222, etc. Se CheckDupChar for False, irá aceitar tais
   números.
}
function ValCPF(cCPF: string; CheckDupChar: Boolean): Boolean;
begin
  Result := ( (not CheckDupChar) or (not TodosCaracteresIguais(cCPF)) ) and
            ( Copy(cCPF,10,2) = DvCPF(cCPF) );
end;

{Função ValCNPJCPF faz a consistência do CGC ou do CPF, conforme o tamanho
         do campo tipo caracter nro - numero do cgc ou cpf}
function ValCNPJCPF(cNumero: string; CheckDupChar: Boolean): String;
begin                                                        
 cNumero := Trim(cNumero);
 Result := 'Dados informados não são nem CPF, nem CNPJ, nem PIS, nem sigla de Estado.';
 if Length(cNumero) = 2 then  
    Result := ChecaEstado(cNumero)
 else
   cNumero := SoNumeros(cNumero, true);                           
   if Length(cNumero) = 11 then
   begin     
     if (ValCPF(cNumero, CheckDupChar)) then
        Result := 'CPF Válido!'
     else
       begin
         if ValidaPis(cNumero) then
           begin
             Result := 'PIS Válido';  
           end;
         else
            Result := 'CPF ou PIS informado não é válido!';
       end;  
   end
   else if Length(cNumero) = 14 then
     Result := ValCNPJ(cNumero, CheckDupChar)                                      
end;

{  procedure btnValidaNumeroClick chama a função ValCNPJCPF e mostra o resultado
   por meio do showmessage}
procedure btnValidaNumeroClick(Sender: TObject);
begin
   try
      if Length(trim(edtCNPJCPF.Text)) > 0 then
         showMessage(ValCNPJCPF(edtCNPJCPF.Text, true));
   finally
      // se quiser permitir apenas uma validação por execução, remover o comentário
      // da linha abaixo
      // ModalResult := mrOk;
   end;
end;