iMasters | Por uma internet mais criativa e dinâmica

Terça-feira, 03/12/2002 - 03:59 - Por Rogério Perez
Seções relacionadas:

• XML

• Imprimir
• Indicar
• Digg it
• Del.icio.us
• Twitter
• 1 comentários

Download dos projetos

Para comemorar o novo site iMasters, preparei uma matéria especial onde mostrarei como fazer um componente que vai Gerar um arquivo XML sem precisar ter que fazer referências ao MSXML.
Bom pessoal, vou explicar um pouco deste componente ActiveX:
1º - Ele vai conter um método chamado GeraXML onde este receberá alguns parâmetros que são:
[ strPathXML = String - Caminho do arquivo a ser criado ]
Obs: o caminho deve existir, o sistema não cria
[ strFileXML = String - Nome do Arquivo ]
Obs: o nome do arquivo pode ou não ter a extenção ".xml"
[ varContent = Variant - Conteudo para Montar o XML ]
Obs: aqui você poderá passar uma Array(Bi-dimensional) ex: arrV(3,2) ou um RecordSet
[ intType = Integer - Define se o varContent é Array ou RecordSet ]
Obs: esta variavel somente poderá ter o valor 1 ou 2.
Para 1 = RecordSer
Para 2 = Array

Este ActiveX também possui um sistema de tratamento de erro que grava um log no caso de eventuais erros, o caminho do arquivo de log é "C:ActiveX_BuildXML_File" e o formato do arquivo é "ddmmyyyy.log" assim os logs são gravados por dia. No caso do componente retornar o valor FALSE verifique o arquivo de log.

Observações Gerais:
O Componente ActiveX.BuildXML_File tem referência ao Microsoft ActiveX Data Object 2.6 (ADO).

Lembrando que para qualquer dúvida estarei atendendo nos e-mais abaixo:
rogerio@austinet.com.br

Códigos

PROJETO ACTIVEX.BUILDXML_FILE

Código da Classe

Option Explicit

'////////////Sub GravaErro
'Desenvolvido por Rogério Perez (I-Manager COM Application)
'Divulgação exclusiva pelo Portal IMASTERS
'Descrição da Sub:
' Gravação de Log de eventuais erro
' gerados pelo componente ActiveX.BuildXML_File.
' A Sub Cria um Diretório chamado C:ActiveX_BuildXML_File
' e nele um arquivo com o formato ddMMyyyy.log,
' onde dd = Dia / MM = Mês / yyyy = Ano
'///////////Fim da Sub

Private Sub GravaErro(ByVal strModulo As String, _
ByVal dblNErr As Double, _
ByVal strDErr As String)

Const strPathLog As String = "C:ActiveX_BuildXML_File"
Dim strFile As String
Dim strNarq As String
strFile = Format(Now, "ddmmyyyy") & ".log"
If Dir(strPathLog, vbDirectory) = "" Then MkDir (strPathLog)
strNarq = strPathLog & strFile
If Dir(strNarq, vbArchive) = "" Then Open strNarq For Output As #2 Else Open strNarq For Append As #2
Print #2, Now & " << " & strModulo & " >> " & dblNErr & " [ " & strDErr & " ] "
Close #2

End Sub

'////////////Function GeraXML
'Desenvolvido por Rogério Perez (I-Manager COM Application)
'Divulgação exclusiva pelo Portal IMASTERS
'Descrição da Function:
' Gera um arquivo XML com os dados a ele fornecido
' Parâmetros:
' strPAthXML = Caminho onde o XML vai ser Gravado
' strFileXML = Nome do Arquivo XML
' varContent = Variavel do tipo Variant pois poderá receber um recordSet ou uma Array
' intType = Variavel do tipo inteiro poderá somente ter 2 valores
' 1 = RecordSet ADO
' 2 = Array
' Retorno:
' Valor Boleno = True(Verdadeiro) = OK
' False(Falso) = ERRO
'///////////Fim da Function

Public Function GeraXML(ByVal strPathXML As String, _
ByVal strFileXML As String, _
ByVal varContent As Variant, _
ByVal intType As Integer) As Boolean

On Local Error GoTo ErrReport

Dim strLineModulo As String
Dim strFullPath As String
Dim strAux As String
Dim objRs As ADODB.Recordset
Dim i As Integer
Dim x As Integer

If Dir(strPathXML, vbDirectory) = "" Then
GeraXML = False
strLineModulo = "Checando Pasta"
GravaErro strLineModulo, 1.1, "Pasta inexistente"
strLineModulo = ""
Exit Function
End If

strLineModulo = "Montando Caminho"
strAux = ""
If Right(strPathXML, 1) = "" Then strAux = strPathXML Else strAux = strPathXML & ""
If InStr(1, strFileXML, ".xml") <> 0 Then strAux = strAux & strFileXML Else strAux = strAux & strFileXML & ".xml"
strFullPath = strAux
strAux = ""

strLineModulo = "Verificando Existencia do Arquivos"
If Dir(strFullPath, vbArchive) <> "" Then Kill strFullPath '//Checa se o arquivo existe e se existir apaga

strLineModulo = "Abrindo arquivo"
Open strFullPath For Output As #1 '//Cria o arquivo xml//
Print #1, ""
Print #1, ""

If intType = 1 Then
strLineModulo = "RecordSet"
Set objRs = varContent
For i = 0 To objRs.Fields.Count - 1
objRs.MoveFirst
Print #1, ""
For x = 0 To objRs.RecordCount - 1
Print #1, ""
Print #1, objRs.Fields(i).Value
Print #1, ""
objRs.MoveNext
Next
Print #1, ""
Next
Set objRs = Nothing
ElseIf intType = 2 Then
strLineModulo = "Array"
For i = 0 To UBound(varContent, 1)
Print #1, ""
For x = 0 To UBound(varContent, 2)
Print #1, ""
Print #1, varContent(i, x)
Print #1, ""
Next
Print #1, ""
Next
Else
GeraXML = True
Exit Function
End If

strLineModulo = "Fechando Arquivo"
Print #1, ""
Close #1
GeraXML = True

strLineModulo = ""

ErrReport:
If Err.Number <> 0 Then
GravaErro strLineModulo, Err.Number, Err.Description
GeraXML = False
End If

End Function

PROJETO STANDARD EXE (TESTE)

Bom pessoal agora chegou a hora de testar o nosso componente, para isso crie um projeto Standard EXE e faça a Referência para o Projeto Acima (ActiveX) e para o Microsoft ActiveX Data Object 2.6 (ADO).

Bom para melhor acompanhar o teste faça download do projeto
[ aqui ] pois como sou colunista COM+ não vou entrar em detalhes sobre Lay-out e Objetos para contruir uma aplicação EXE, isso deixa para o meu amigo colunista de Visual Basic (risos).

Bom no código abaixo, merece algumas observações, as informações para a conexão e o recordset estão especificados para um servidor (fantasia), então atenção e mudar caso você queira passar um RecordSet para o componente. Já para a Array não precisa fazer nenhuma alteração.

Código do Form

Option Explicit

Private Sub Command1_Click()

Dim objT As ActiveX.BuildXML_File
Dim objC As ADODB.Connection
Dim objR As ADODB.RecordsetDim arrT() As String
Set objT = New ActiveX.BuildXML_File

If OptType(1).Value = True Then

Set objC = New ADODB.Connection
Set objR = New ADODB.Recordset

'//ATENÇÃO MUDAR O PROVIDER SE NECESSÁRIO
objC.Provider = "SQLOLEDB.1"
'//ATENÇÃO MUDAR A CONNECTION STRING PARA UMA BASE REAL
objC.ConnectionString = "Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=BASE_REAL;Data Source=(local)"
objC.Open

objR.ActiveConnection = objC
objR.CursorLocation = adUseClient
objR.CursorType = adOpenKeyset
'//ATENÇÃO MUDAR O SOURCE PARA UM SELECT EM UMA TABELA REAL
objR.Source = "SELECT * FROM NOME_DA_TABELA"
objR.Open
objR.ActiveConnection = Nothing

MsgBox objT.GeraXML("c:", "XMLRecordSet", objR, 1)

objR.Close

Set objC = Nothing
Set objR = Nothing

ElseIf OptType(0).Value = True Then

ReDim arrT(3, 2)
arrT(0, 0) = "Teste 1.1"
arrT(0, 1) = "Teste 1.2"
arrT(0, 2) = "Teste 1.3"

arrT(1, 0) = "Teste 2.1"
arrT(1, 1) = "Teste 2.2"
arrT(1, 2) = "Teste 2.3"

arrT(2, 0) = "Teste 3.1"
arrT(2, 1) = "Teste 3.2"
arrT(2, 2) = "Teste 3.3"

arrT(3, 0) = "Teste 4.1"
arrT(3, 1) = "Teste 4.2"
arrT(3, 2) = "Teste 4.3"

MsgBox objT.GeraXML("c:", "XMLArray", arrT, 2)

End If

Set objT = Nothing

End Sub

Bom pessoal, bom estudo dos projetos e qualquer dúvida é só mandar e-mail para que eu possa esclarece-lás. Uma boa semana a todos.

Rogério Perez
MCSD Microsoft - Profile Visual Basic
Gerente de Tecnologia - Austin Asis
rogerio@austinet.com.br

1 comentários publicados

• 1. Erro

  Terça-feira, 27/12/2005, por Roney Ayres Pimenta Alves de L
  

  Ao executar este projeto aconteceu o erro abaixo:
  "No creatable public component detected. Press F1 for more information."
  Como resolver isso?
  Obrigado!

  Responder comentário

Poste um comentário

(clique se não for cadastrado)

Login: Senha: Titulo: digite aqui seu comentário Site/blog: Enviar Receber notificação de novos comentários

Sobre o autor

Rogério Perez é CIO da LayerDev Sistemas, graduado em Marketing, MCSD.Net e MCAD.Net perfil C# pela Microsoft. Trabalha na integração entre diversos sistemas utilizando WebServices e também é Consultor de Negócios (UML).

Indique para um amigo

Escreva aqui sua mensagem! ok

Tags relacionadas

windows iphone apple criação firefox desenvolvimento linux mobile 3g mercado youtube crescimento celular ti tecnologia php internet yahoo lançamento brasil google microsoft twitter android seguranca web

TI SHOP Produtos iMasters

• Lançamento: CD-ROM Treinamento Aplicado de SQL - Lançamento! Treinamento Aplicado de SQL - Aprenda a trabalhar com SQL com bancos de dados Oracle e SQL Server. São mais de 100 tópicos explicados por Mauro Pichilliani, um articulistas mais lidos do iMasters. Aproveite! Apenas R$ 69,90 no TI SHOP.
• Lançamento: Livro iMasters "O Encontro de 2 Mundos"- Este livro conta com 56 crônicas de profissionais mais admirados e influentes do mercado brasileiro de Internet. Aproveite o preço especial para leitores do iMasters. Apenas R$ 40,00 e envio imediato!
• DVD Curso Completo de Photoshop - Do conceito à finalização Lançamento! Curso Completo de Photoshop, em DVD, com mais de 230 aulas dividas em 4 módulos: conceito, básico, avançado e finalização. Apenas R$ 69,50 no TI SHOP - Frete com 50% de desconto
• DVD Javascript Starter - Curso Completo Com mais de 9 horas de vídeo-aulas, é um curso completo sobre Javascript. Ideal para quem deseja aprender a linguagem. Apenas R$ 64,90 no TI SHOP - Frete com 50% de desconto!