Como validar um XML com um XSD usando o Delphi?
Escrito por Carlos B. Feitoza Filho | |
Categoria: Artigos | |
Categoria Pai: Addicted 2 Delphi! | |
Acessos: 15766 |
Por uma feliz coincidência, quando eu comecei a buscar uma resposta para esta pergunta, eu estava terminando de desenvolver o exemplo que foi usado no artigo "Como usar corretamente uma barra de progresso (TProgressBar)?", então, a validação de um XML com um XSD foi a primeira solução real na qual a classe TProgressThread foi utilizada. Se você ainda não leu o artigo em questão, recomendo que o faça agora, clicando aqui.
A primeira versão desta solução utilizou uma forma de validação muito básica que retornava apenas o resultado da primeira checagem. Como eu usava o plugin do Notepad++ eu queria ver um resultado tal como ele retorna, mostrando o resultado da validação para cada elemento (nó xml) validado. Isso dá ao usuário uma informação precisa acerca do que está errado.
Após algumas pesquisas eu descobri o que faltava e ajustei a versão inicial. O resultado veio do jeito que eu queria e eu já ia entregar a solução, quando resolvi comparar a saída de meu validador, com a saída do validador do Notepad++. Foi aí que eu descobri que ele não estava validando corretamente as restrições únicas (unique constraints) contidas no XSD. Houve um XML com 3 erros de chaves duplicadas mas apenas a primeira era reportada pelo meu validador. Voltei a pesquisar.
Depois de algum tempo eu descobri um exemplo que usava uma forma totalmente diferente de validação, usando a interface ISAXXMLReader. Esta interface possui propriedades específicas para manipulação de conteúdo e manipulação de erros de validação (ContentHandler e ErrorHandler respectivamente). Cada uma destas propriedades deve receber uma instância de uma classe específica. Uma classe que implementa IVBSAXErrorHandler e outra que implementa IVBSAXContentHandler. Isso dá ao programador um controle absoluto do que fazer em cada situação. Eu não usei todas as capacidades desta implementação, me concentrei apenas na validação, mas certamente é possível realizar muito mais coisas com ela.
Abaixo está a unit UValidateXMLXSD. É nela onde está a classe TValidateXMLXSD, derivada de TProgressThread, e que é a responsável por executar a validação:
unit UValidateXMLXSD;
interface
uses
UProgressThread, Classes;
type
TValidateXMLXSD = class (TProgressThread)
private
FXSDFile: String;
FXMLFile: String;
FResult: TStringList;
FIgnoreDuplicates: Boolean;
function ValidateXMLXSD(PXMLFile, PXSDFile: string; PIgnoreDuplicates: Boolean): TStringList;
public
constructor Create; override;
destructor Destroy; override;
procedure Execute; override;
property XMLFile: String write FXMLFile;
property XSDFile: String write FXSDFile;
property IgnoreDuplicates: Boolean write FIgnoreDuplicates;
property Result: TStringList read FResult;
end;
implementation
uses
SysUtils, ComObj, ActiveX, MSXML2_TLB;
type
TSaxErrorHandler = class (TInterfacedObject, IVBSAXErrorHandler)
private
FListaDeErros: TStringList;
FIgnoreDuplicates: Boolean;
public
constructor Create(PListaDeErros: TStringList; PIgnoreDuplicates: Boolean);
// TInterfacedObject
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
// IVBSAXErrorHandler
procedure Error(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; nErrorCode: Integer); safecall;
procedure FatalError(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; nErrorCode: Integer); safecall;
procedure IgnorableWarning(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; nErrorCode: Integer); safecall;
end;
TSaxContentHandler = class (TInterfacedObject, IVBSAXContentHandler)
protected
FPath: TStringList;
public
constructor Create; virtual;
destructor Destroy; override;
// TInterfacedObject
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
// IVBSAXContentHandler
procedure _Set_documentLocator(const Param1: IVBSAXLocator); virtual; safecall;
procedure startDocument; virtual; safecall;
procedure endDocument; virtual; safecall;
procedure startPrefixMapping(var strPrefix: WideString; var strURI: WideString); virtual; safecall;
procedure endPrefixMapping(var strPrefix: WideString); virtual; safecall;
procedure startElement(var strNamespaceURI: WideString; var strLocalName: WideString; var strQName: WideString; const oAttributes: IVBSAXAttributes); virtual; safecall;
procedure endElement(var strNamespaceURI: WideString; var strLocalName: WideString; var strQName: WideString); virtual; safecall;
procedure characters(var strChars: WideString); virtual; safecall;
procedure ignorableWhitespace(var strChars: WideString); virtual; safecall;
procedure processingInstruction(var strTarget: WideString; var strData: WideString); virtual; safecall;
procedure skippedEntity(var strName: WideString); virtual; safecall;
end;
TTagReaded = class (TSaxContentHandler)
private
FValidateXMLXSD: TValidateXMLXSD;
public
constructor Create(PValidateXMLXSD: TValidateXMLXSD); reintroduce;
procedure startElement(var strNamespaceURI: WideString; var strLocalName: WideString; var strQName: WideString; const oAttributes: IVBSAXAttributes); override; safecall;
end;
{ TValidateXMLXSD }
constructor TValidateXMLXSD.Create;
begin
inherited;
end;
destructor TValidateXMLXSD.Destroy;
begin
inherited;
end;
procedure TValidateXMLXSD.Execute;
var
XMLDocument: Variant;
begin
inherited;
Max := 0;
CoInitialize(nil);
try
try
XMLDocument := CreateOLEObject('MSXML2.DOMDocument.6.0');
XMLDocument.load(FXMLFile);
Max := XMLDocument.documentElement.selectNodes('//*').Length;
DoMax;
finally
XMLDocument := varNull;
end;
FResult := ValidateXMLXSD(FXMLFile,FXSDFile,FIgnoreDuplicates);
finally
CoUnInitialize;
end;
end;
function TValidateXMLXSD.ValidateXMLXSD(PXMLFile, PXSDFile: string; PIgnoreDuplicates: Boolean): TStringList;
var
SAXXMLReader: IVBSAXXMLReader;
XMLSchemaCache: Variant;
begin
// Criando uma coleção de esquemas (XSD)
XMLSchemaCache := CreateOleObject('MSXML2.XMLSchemaCache.6.0');
try
// Criando um leitor SAX (XML)
SAXXMLReader := CreateOleObject('MSXML2.SAXXMLReader.6.0') as IVBSAXXMLReader;
// Adicionando o arquivo de esquema na coleção
XMLSchemaCache.Add('',PXSDFile);
// Configurando o leitor SAX para validar o documento XML que nele for carregado
SAXXMLReader.putFeature('schema-validation', True);
SAXXMLReader.putFeature('exhaustive-errors', True);
SAXXMLReader.putProperty('schemas', XMLSchemaCache);
Result := TStringList.Create;
// Atribuindo manipuladores necessários. TSaxErrorHandler manipula apenas os erros
// e TTagReaded manipula cada nó lido
SAXXMLReader.errorHandler := TSaxErrorHandler.Create(Result,PIgnoreDuplicates);
SAXXMLReader.contentHandler := TTagReaded.Create(Self);
// Executa a validação
try
SAXXMLReader.ParseURL(PXMLFile);
except
{ Evita que as exceções decorrentes de erros de validação parem um processamento em lote }
end;
finally
XMLSchemaCache := varNull;
end;
end;
{ TSaxErrorHandler }
constructor TSaxErrorHandler.Create(PListaDeErros: TStringList; PIgnoreDuplicates: Boolean);
begin
FListaDeErros := PListaDeErros;
FIgnoreDuplicates := PIgnoreDuplicates;
end;
procedure TSaxErrorHandler.Error(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; nErrorCode: Integer);
var
Erro: String;
begin
Erro := '[ERRO]: ' + Trim(StringReplace(strErrorMessage,#13#10,' ',[rfReplaceAll]));
if (not FIgnoreDuplicates) or (FListaDeErros.IndexOf(Erro) = -1) then
FListaDeErros.Add(Erro);
end;
procedure TSaxErrorHandler.FatalError(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; nErrorCode: Integer);
begin
FListaDeErros.Add('[ERRO FATAL]: ' + Trim(StringReplace(strErrorMessage,#13#10,' ',[rfReplaceAll])));
end;
function TSaxErrorHandler.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
function TSaxErrorHandler.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
function TSaxErrorHandler.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
procedure TSaxErrorHandler.IgnorableWarning(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; nErrorCode: Integer);
var
Erro: String;
begin
Erro := '[AVISO]: ' + Trim(StringReplace(strErrorMessage,#13#10,' ',[rfReplaceAll]));
if (not FIgnoreDuplicates) or (FListaDeErros.IndexOf(Erro) = -1) then
FListaDeErros.Add(Erro);
end;
function TSaxErrorHandler.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
{ TMySaxHandler }
procedure TSaxContentHandler.characters(var strChars: WideString);
begin
{ Este método é executado para exibir o conteúdo de um tag. Normalmente o que
acontece é <tag>strChars</tag>, logo este procedure pode ser usado para obter
texto plano que está contido dentro de um tag }
end;
constructor TSaxContentHandler.Create;
begin
FPath := TStringList.Create;
end;
destructor TSaxContentHandler.Destroy;
begin
FPath.Free;
inherited;
end;
procedure TSaxContentHandler.endDocument;
begin
{ Este método é executado após a leitura do documento chegar ao final }
end;
procedure TSaxContentHandler.endElement(var strNamespaceURI, strLocalName, strQName: WideString);
begin
{ Este método é executado quando um tag de fechamento é encontrado }
FPath.Delete(Pred(FPath.Count));
end;
procedure TSaxContentHandler.endPrefixMapping(var strPrefix: WideString);
begin
{ Não usado }
end;
function TSaxContentHandler.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
function TSaxContentHandler.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
function TSaxContentHandler.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
procedure TSaxContentHandler.ignorableWhitespace(var strChars: WideString);
begin
{ Não usado }
end;
function TSaxContentHandler.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
Result := E_NOTIMPL; { Não usado }
end;
procedure TSaxContentHandler.processingInstruction(var strTarget, strData: WideString);
begin
{ Não usado }
end;
procedure TSaxContentHandler.skippedEntity(var strName: WideString);
begin
{ Não usado }
end;
procedure TSaxContentHandler.startDocument;
begin
{ Este método é executado antes da leitura do documento começar }
end;
procedure TSaxContentHandler.startElement(var strNamespaceURI, strLocalName, strQName: WideString; const oAttributes: IVBSAXAttributes);
begin
{ Este método é executado quando um tag de abertura é encontrado }
FPath.Add(strLocalName);
end;
procedure TSaxContentHandler.startPrefixMapping(var strPrefix, strURI: WideString);
begin
{ Não usado }
end;
procedure TSaxContentHandler._Set_documentLocator(const Param1: IVBSAXLocator);
begin
{ Não usado }
end;
{ TTagReaded }
constructor TTagReaded.Create(PValidateXMLXSD: TValidateXMLXSD);
begin
inherited Create;
FValidateXMLXSD := PValidateXMLXSD;
end;
procedure TTagReaded.startElement(var strNamespaceURI, strLocalName, strQName: WideString; const oAttributes: IVBSAXAttributes);
begin
inherited;
FValidateXMLXSD.Text := strLocalName;
FValidateXMLXSD.Number := 0;
FValidateXMLXSD.DoProgress;
end;
end.
Não tem como eu explicar todas as linhas dessa unit, por preguiça e por falta de conhecimentos aprofundados (não vou falar do que não tenho certeza), mas vou explicar o que é mais relevante. Para coisas mais simples eu mantive os comentários na própria classe.
A classe TValidateXMLXSD (linha 9) é nossa thread de trabalho (derivada de TProgressThread). O método ValidateXMLXSD (linha 15) dessa classe, é o responsável pela validação do XML. Note que a classe possui 3 propriedades de entrada (write-only) e uma propriedade de saída (read-only) nas linhas 20 a 23. As propriedades de entrada são XMLFile, XSDFile e IgnoreDuplicates. Elas mapeiam para parâmetros do método ValidadeXMLXSD. Já a propriedade Result vai conter o resultado da validação, retornado pela função ValidadeXMLXSD. Este resultado é uma lista de erros (TStringList) a qual, obviamente, estará vazia, caso nenhum erro tenha sido encontrado.
A linha 29 contém uma unit estranha de nome MSXML2_TLB. Esta unit não vem com o Delphi, mas você precisa adicioná-la também ao seu projeto. Eu também não a estou distribuindo no zip anexado a estre artigo por um simples motivo: você pode gerar esta unit usando o próprio Delphi! Se você nunca importou uma biblioteca de tipos (Type Library), no final deste artigo eu ensino como gerar a MSXML2_TLB.pas, mas por ora, vou considerar que você já a possui, pois vou continuar a explicar a unit UValidateXMLXSD.
As linhas 32 (TSaxErrorHandler), 49 (TSaxContentHandler) e 74 (TTagReaded) definem 3 classes que serão usadas como classes manipuladoras pela interface ISAXXMLReader. As duas primeiras são implementações diretas das interfaces IVBSAXErrorHandler e IVBSAXContentHandler respectivamente. A terceira (TTagReaded) é uma especialização (classe filha) de TSaxContentHandler. Eu poderia usar diretamente a classe TSaxContentHandler, mas resolvi implementar uma classe filha como exemplo, pois podemos implementar várias classes filhas com funcionalidades distintas, e que contém uma funcionalidade comum (classe pai). Isso poderia ter sido feito também com TSaxErrorHandler, mas esta eu usei diretamente.
Na linha 120 encontramos o método principal da thread, responsável por realizar a validação do aquivo XML, dentro dele, nas linhas 142 e 143 está a atribuição das classes manipuladoras às propriedades SAXXMLReader.ErrorHandler e SAXXMLReader.ContentHandler. Note que a atribuição é feita simplesmente criando uma instância de cada uma das classes diretamente na sua propriedade correspondente. Como as propriedades são interfaces, não é necessário liberar as classes criadas (Free).
A linha 149 não foi erro de digitação e nem é uma gambiarra. Eu chamo essa técnica de "mudinho" ou "bico calado". Bom, não é uma técnica de fato, mas foi uma necessidade. O método ParseURL (linha 147) inicia o processo de validação nó a nó do XML. Quando um erro é encontrado em um nó, um flag interno de erro é ativado, mas o processamento continua até que não sobre mais nenhum nó. Ao terminar o processamento, o método ParseURL verifica o flag interno e se ele estiver ativado, uma exceção é levantada. Como nesta implementação eu estou salvando cada erro numa lista (TStringList), não é necessário manipular a exceção, pois caso a lista contenha itens eu saberei que houve erros, logo, eu estou emudecendo qualquer exceção levantada por ParseURL. Você poderia manipular a exceção e exibir nela uma mensagem mais amigável ao usuário. Eu não fiz isso porque este método seria usado por mim numa rotina em lote (vários arquivos sendo validados), logo, eu não poderia mostrar uma mensagem toda vez que houvesse erros. Outra coisa que poderia ser feita na manipulação desta exceção seria adicionar um item a mais na lista de erros. Tudo isso fica a critério do desenvolvedor. A solução, como está, atende às minhas necessidades.
Nas linhas 164, 173 e 193 estão declarados os métodos que são executados quando o parser encontra problemas. TSaxErrorHandler.Error é executado quando há um erro de validação em um nó mas o parser continua. TSaxErrorHandler.FatalError é executado quando um erro grave é encontrado e neste caso o parser para imediatamente. TSaxErrorHandler.IgnorableWarning é executado quando há algo estranho em algum nó, mas que não caracteriza um erro e o parser continua.
Na linha 307 está o método que é executado para cada nó lido. Especificamente, o método TTagReaded.StartElement (TSaxContentHandler.StartElement) é executado cada vez que um tag de abertura é encontrado. Nas linguagens de marcação, os elementos podem ser compostos por um tag de abertura (<a>, por exemplo) e um tag de fechamento (</a>, por exemplo) ou apenas um tag de abertura (<br />, por exemplo), logo, este método é executado para todo e qualquer tag (nó do XML) encontrado e é o local ideal para se executar o método DoProgress, o qual gera o evento OnProgress, no qual uma barra de progresso pode ser incrementada.
Para utilizar a classe TValidateXMLXSD, crie um campo privado em um form (FValidateXMLXSD no exemplo) e proceda da seguinte forma:
MEMO.Lines.Add('Validando o arquivo "arquivo.xml"'#13#10);
FValidateXMLXSD := TValidateXMLXSD.Create;
with FValidateXMLXSD do
begin
XMLFile := 'arquivo.xml'; { informe o arquivo xml }
XSDFile := 'arquivo.xsd'; { informe o esquema xsd para validar o arquivo }
IgnoreDuplicates := False; { usar true, gera menos saída, caso haja erros }
OnMax := DoMax; { evento para configurar uma barra de progresso }
OnProgress := DoProgress; { evento para incrementar uma barra de progresso}
OnTerminate := DoTerminate; { evento ativado quando a thread termina }
Resume;
end;
Não vou explicar o que cada uma destas linhas faz porque isso já foi coberto no artigo "Como usar corretamente uma barra de progresso (TProgressBar)?". Se você ainda não o leu, recomendo fazer isso. O artigo está muito bem escrito por um grande amigo meu, o qual conheço muito bem :) Ao terminar a validação do arquivo, o evento OnTerminate vai ser ativado. É nele onde devemos verificar a resposta (lista de erros) e gerar uma saída adequada para o usuário. Neste exemplo eu usei um TMemo de nome MEMO para mostrar o resultado da validação. Veja como foi feito:
procedure TFormValidarXML.DoTerminate(PSender: TObject);
begin
try
{ caso haja linhas no resultado, significa que houve erros, logo, devemos mostrá-los }
if FValidateXMLXSD.Result.Count > 0 then
begin
MEMO.Lines.Add('Os seguintes erros de validação foram encontrados:'#13#10);
MEMO.Lines.Add(FValidateXMLXSD.Result.Text);
end
else
MEMO.Lines.Add('Este arquivo não contém erros!'#13#10);
finally
FValidateXMLXSD.Result.Free;
end;
MEMO.Lines.Add('-------------'); { isso é apenas um separador. Pode ser omitido }
end;
Basicamente isso é tudo que você precisa fazer para validar um XML com seu XSD no Delphi usando uma thread :)
Como importar uma Type Library no Delphi
Segundo a Microsoft uma Type Library (biblioteca de tipos) é:
Um arquivo binário que armazena informações sobre propriedades e métodos de objetos COM ou DCOM, numa forma que é acessível a outras aplicações em tempo de execução. Usando uma biblioteca de tipos uma aplicação pode determinar quais interfaces um objeto suporta e invocar os métodos da interface deste objeto. Isso pode ser feito mesmo se o objeto e a aplicação cliente tiverem sido escritas em linguagens diferentes.
Em outras palavras uma biblioteca de tipos contém informações sobre tipos (objetos) e podem ser usadas para instanciar estes objetos em qualquer aplicação, escrita em qualquer linguagem!
O validador de XML descrito neste artigo, utiliza objetos, constantes e tipos disponíveis na biblioteca MSXML que é uma biblioteca de tipos. Precisamos então importar esta dll com o Delphi a fim de gerar a unit MSXML_TLB.pas, a qual é utilizada (uses) na unit UValidateXMLXSD. Siga os passos abaixo para importar uma biblioteca de tipos:
- Clique no item de menu Component > Import Component... O wizard Import Component vai aparecer
- Selecione a opção Import a Type Library e pressione o botão Next >>. A próxima etapa vai aparecer
- Na lista de bibliotecas selecione Microsoft XML. Note que no meu caso, existem 3 versões de biblioteca disponíveis, v3.0, v4.0 e v6.0. Escolha a versão mais recente, no meu caso é a versão 6.0. Existe uma observação muito importante a respeito destas versões. Não esqueça de ler a última seção deste artigo. Clique o botão Next >>. A próxima etapa vai aparecer
- Nesta tela nada precisa ser feito, deixe tudo como está e pressione Next >>. A próxima etapa vai aparecer
- Agora, selecione a opção Add unit to <NomeDoProjeto> project e pressione o botão Finish.
Ao executar o passo 5 acima, a unit MSXML2_TLB vai ser adicionada ao projeto <NomeDoProjeto> e poderá ser salva como qualquer outra unit juntamente com os fontes do seu sistema.
IMPORTANTE!: Sobre as versões de MSXML e os arquivos anexados a este exemplo
Quando eu desenvolvi esta solução de validação eu importei a versão 6.0 de MSXML, sendo assim, dentro do arquivo UValidateXMLXSD, existem referências a esta versão. Observe as linhas 106, 126 e 129. Em todas elas, ao informar o identificador da classe eu incluo o valor apropriado da versão, no caso 6.0.
Portanto, ao importar a biblioteca de tipo MSXML, caso a versão mais recente disponível não seja a 6.0, você precisará alterar as 3 linhas citadas no parágrafo anterior de forma a conter a versão correta, do contrário podem acontecer coisas estranhas ou a classe TValidateXMLXSD pode não funcionar por completo. Você precisará, pois, usar 3.0 ou 4.0 nos identificadores, dependendo da versão que foi importada.