checkdoc.pas

delphi cnpj and cpf validator

unit CheckDoc;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DsgnIntf;

type
  TMode = (moCPF, moCGC);

  TCheckDoc = class(TComponent)
  private
    FAbout  : string;
    FInput  : string;
    FResult : Boolean;
    FMode   : TMode;
    procedure SetInput(Value: string);
    procedure SetMode(Value: TMode);
    procedure SetCPF(Value: string);
    procedure SetCGC(Value: string);
    procedure SetResult(Value: boolean);
    procedure ShowAbout;
  protected
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  published
    property About    : string  read FAbout     write FAbout      stored  False;
    property Input    : string  read FInput     write SetInput;
    property Mode     : TMode   read FMode      write SetMode;
    property Result   : boolean read FResult    write SetResult;
  end;

procedure Register;

implementation

{#######################################################################}

type
  TAboutProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function  GetAttributes: TPropertyAttributes; override;
    function  GetValue : string; override;
  end;

procedure TAboutProperty.Edit;
{Invoke the about dialog when clicking on ... in the Object Inspector}
begin
  TCheckDoc(GetComponent(0)).ShowAbout;
end;

function TAboutProperty.GetAttributes: TPropertyAttributes;
{Make settings for just displaying a string in the ABOUT property in the
Object Inspector}
begin
  GetAttributes := [paDialog, paReadOnly];
end;

function TAboutProperty.GetValue: String;
{Text in the Object Inspector for the ABOUT property}
begin
  GetValue := '(About)';
end;

procedure TCheckDoc.ShowAbout;
var
  msg: string;
const
  carriage_return = chr(13);
begin
  msg := 'CheckDoc  v1.0';
  AppendStr(msg, carriage_return);
  AppendStr(msg, 'A freeware component');
  AppendStr(msg, carriage_return);
  AppendStr(msg, carriage_return);
  AppendStr(msg, 'by Roger Constantin Demetrescu');
  AppendStr(msg, carriage_return);
  AppendStr(msg, carriage_return);
  AppendStr(msg, '[e-mail]');
  ShowMessage(msg);
end;

{#######################################################################}

constructor TCheckDoc.Create( Aowner: Tcomponent);
begin
  inherited Create( Aowner );
  FInput  := '';
  FResult := False;
  FMode   := moCPF;
end;

destructor TCheckDoc.Destroy;
begin
  inherited Destroy;
end;

procedure TCheckDoc.SetMode(Value: TMode);
begin
  if FMode <> Value then
  begin
    FMode := Value;
    SetInput(FInput);
  end;
end;

procedure TCheckDoc.SetInput(Value: string);
begin
  FInput := Value;
  case FMode of
    moCPF: SetCPF(Value);
    moCGC: SetCGC(Value);
  end;
end;

procedure TCheckDoc.SetCPF(Value: string);
var
  localCPF       : string;
  localResult    : boolean;
  digit1, digit2 : integer;
  ii,soma        : integer;
begin
  localCPF := '';
  localResult := False;

  {analisa CPF no formato 999.999.999-00}
  if Length(FInput) = 14 then
    if (Copy(FInput,4,1)+Copy(FInput,8,1)+Copy(FInput,12,1) = '..-') then
      begin
      localCPF := Copy(FInput,1,3) + Copy(FInput,5,3) + Copy(FInput,9,3) +
                   Copy(FInput,13,2);
      localResult := True;
      end;

  {analisa CPF no formato 99999999900}
  if Length(FInput) = 11 then
    begin
    localCPF := FInput;
    localResult := True;
    end;

  {comeca a verificacao do digito}
  if localResult then
    try
      {1