IMPORTA?ÃO DE XML
Bom dia galera.
Estou precisando de módulo para importação de XML para abastecer o estoque/financeiro do meu sistema.
Alguem tem alguma coisa em Vb6 ou C#(preferencia neste último) que possa me passar com fontes por um preço bacana?
Estou sem tempo de desenvolver.
Estou precisando de módulo para importação de XML para abastecer o estoque/financeiro do meu sistema.
Alguem tem alguma coisa em Vb6 ou C#(preferencia neste último) que possa me passar com fontes por um preço bacana?
Estou sem tempo de desenvolver.
podemos conversar;
vc tem modelo doque vc precisa;
cel / whatsapp: 05196215686
vc tem modelo doque vc precisa;
cel / whatsapp: 05196215686
Se for para importação de XML de NFe eu tenho.
Entre em contato via skype ou email.
Skype: Ekklesia.Soft
Email: suporte@ekklesiasoft.com.br
Entre em contato via skype ou email.
Skype: Ekklesia.Soft
Email: suporte@ekklesiasoft.com.br
Seria muito util uma postagem aqui. Creio que ajudaria em muitos! 
FBGSYSTEMS, segue um trecho básico para ate ajudar (aqui para importar XML da NFe), isso eu fiz quando surgiu a NFe, acredito que alguém tenha feito algo mais fácil
**** Em um form
Private Sub Separar_Tag(sXml)
Dim sCaminho As String
Set myXML = New DOMDocument
myXML.resolveExternals = True
myXML.validateOnParse = True
myXML.async = False
sCaminho = Dir1 & [Ô]\[Ô] & File1.FileName
myXML.Load sCaminho
Item = VerificaItempro([Ô]<infProt>[Ô], [Ô]</infProt>[Ô], myXML.xml)
If Item <> [Ô][Ô] Then
Separar_Item Item
End If
Item = VerificaItempro([Ô]<ide>[Ô], [Ô]</ide>[Ô], myXML.xml)
If Item <> [Ô][Ô] Then
Separar_Item Item
End If
end sub
Function Verifica_Conteudo(sString, lpos1, lpos2, lpos)
[ô]Dim posicao1 As Integer
[ô]Dim posicao2 As Integer
Dim tamanho As Integer
Dim nPosCST1 As String
Dim nPosCST2 As String
Dim nPosBC1 As String
Dim nPosBC2 As String
Dim nPosPIS1 As String
Dim nPosPis2 As String
Dim nPosvPIS1 As String
Dim nPosvPIS2 As String
Dim nPosCof1 As String
Dim nPosCof2 As String
Dim nPosvCof1 As String
Dim nPosvCof2 As String
If lpos = 0 Then
lpos = 1
End If
posicao1 = InStr(lpos, sString, lpos1) [ô]saber qual a posicao que comeca por exemplo <cProd>
posicao2 = InStr(lpos, sString, lpos2) [ô]saber qual a posicao que comeca por exemplo </cProd>
If lpos1 = [Ô]<chNFe>[Ô] Then
posicao1 = posicao1 + 7
tamanho = posicao2 - posicao1 [ô]ver (<cProd> e </cProd>) a diferença para pegar o conteúdo nesse caso o código do Ãtem
Verifica_Conteudo = Mid(sString, posicao1, 44)
End If
If lpos1 = [Ô]<nNF>[Ô] Then
posicao1 = posicao1 + 5
tamanho = posicao2 - posicao1 [ô]ver (<cProd> e </cProd>) a diferença para pegar o conteúdo nesse caso o código do Ãtem
Verifica_Conteudo = Mid(sString, posicao1, tamanho)
End If
If lpos1 = [Ô]<dEmi>[Ô] Then
posicao1 = posicao1 + 6
tamanho = posicao2 - posicao1 [ô]ver (<cProd> e </cProd>) a diferença para pegar o conteúdo nesse caso o código do Ãtem
Verifica_Conteudo = Mid(sString, posicao1, tamanho)
End If
end sub
Private Function VerificaItempro(ByVal sTagPaiIni As String, ByVal sTagPaiFim As String, ByVal strResp As String) As String
On Error Resume Next
Dim lpos1 As Long, lpos2 As Long, lPos3 As Long, lPos4 As Long
[ô]VerificaItem = [Ô][Ô]
[ô]verificando valor do cStat resultante do web service a partir do final do código XML
lpos1 = InStrRev(strResp, sTagPaiIni) + Len(sTagPaiIni)
lpos2 = InStrRev(strResp, sTagPaiFim)
If lpos1 > Len(sTagPaiIni) And lpos2 > lpos1 Then
strResp = Mid(strResp, lpos1, lpos2 - lpos1)
VerificaItempro = strResp
[ô]gravar_txt strResp
Exit Function
End If
lpos1 = InStrRev(strResp, sTagPaiIni) + Len(sTagPaiIni)
lpos2 = InStrRev(strResp, [Ô]</det>[Ô])
If lpos1 > Len(sTagPaiIni) And lpos2 > lpos1 Then
strResp = Mid(strResp, lpos1, lpos2 - lpos1)
VerificaItempro = strResp
Exit Function
End If
End Function
Private Sub Separar_Item(sDesc)
Dim sPriPos As Integer
Dim sUltPos As Integer
Dim x As String
Dim nUlt As String
sChave = Verifica_Conteudo(sDesc, [Ô]<chNFe>[Ô], [Ô]</chNFe>[Ô], lpos)
end sub
*****COLOCAR EM UM MODULO
Option Explicit
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
Declare Function CallWindowProc Lib [Ô]user32[Ô] Alias [Ô]CallWindowProcA[Ô] (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib [Ô]user32[Ô] Alias [Ô]SetWindowLongA[Ô] (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib [Ô]shell32.dll[Ô] Alias [Ô]Shell_NotifyIconA[Ô] (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
[ô]Private TheData As NOTIFYICONDATA
Public TheData As NOTIFYICONDATA
[ô] -- Api SetForegroundWindow Para traer la ventana al frente
Private Declare Function SetForegroundWindow Lib [Ô]user32[Ô] (ByVal hWnd As Long) As Long
[ô][ô] -- Api para desplegar el cuadro de diálogo Acerca de ...
Private Declare Function ShellAbout Lib [Ô]shell32.dll[Ô] Alias [Ô]ShellAboutA[Ô] (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
[ô][ô] -- Constantes para los botones y le mouse (mensajes)
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
[ô]Private Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
[ô]Private Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
[ô] *********************************************
[ô] The replacement window proc.
[ô] *********************************************
Public Function NewWindowProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If msg = TRAY_CALLBACK Then
[ô] The user clicked on the tray icon.
[ô] Look for click events.
If lParam = WM_LBUTTONUP Then
[ô] On left click, show the form.
If TheForm.WindowState = vbMinimized Then _
TheForm.WindowState = TheForm.LastState
TheForm.SetFocus
[ô]Exit Function
End If
If lParam = WM_RBUTTONUP Then
[ô] On right click, show the menu.
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
[ô] Send other messages to the original
[ô] window proc.
If msg <> 133 Then
NewWindowProc = CallWindowProc( _
OldWindowProc, hWnd, msg, _
wParam, lParam)
End If
End Function
[ô] *********************************************
[ô] Add the form[ô]s icon to the tray.
[ô] *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
[ô] ShowInTaskbar must be set to False at
[ô] design time because it is read-only at
[ô] run time.
[ô] Save the form and menu for later use.
Set TheForm = frm
Set TheMenu = mnu
[ô] Install the new WindowProc.
OldWindowProc = SetWindowLong(frm.hWnd, _
GWL_WNDPROC, AddressOf NewWindowProc)
[ô] Install the form[ô]s icon in the tray.
With TheData
.uId = 0
.hWnd = frm.hWnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON
.ucallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
[ô] *********************************************
[ô] Remove the icon from the system tray.
[ô] *********************************************
Public Sub RemoveFromTray()
[ô] Remove the icon from the tray.
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData
[ô] Restore the original window proc.
SetWindowLong TheForm.hWnd, GWL_WNDPROC, _
OldWindowProc
End Sub
[ô] *********************************************
[ô] Set a new tray tip.
[ô] *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
[ô] *********************************************
[ô] Set a new tray icon.
[ô] *********************************************
Public Sub SetTrayIcon(pic As Picture)
[ô] Do nothing if the picture is not an icon.
If pic.Type <> vbPicTypeIcon Then Exit Sub
[ô] Update the tray icon.
With TheData
.hIcon = pic.Handle
.uFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
**** Em um form
Private Sub Separar_Tag(sXml)
Dim sCaminho As String
Set myXML = New DOMDocument
myXML.resolveExternals = True
myXML.validateOnParse = True
myXML.async = False
sCaminho = Dir1 & [Ô]\[Ô] & File1.FileName
myXML.Load sCaminho
Item = VerificaItempro([Ô]<infProt>[Ô], [Ô]</infProt>[Ô], myXML.xml)
If Item <> [Ô][Ô] Then
Separar_Item Item
End If
Item = VerificaItempro([Ô]<ide>[Ô], [Ô]</ide>[Ô], myXML.xml)
If Item <> [Ô][Ô] Then
Separar_Item Item
End If
end sub
Function Verifica_Conteudo(sString, lpos1, lpos2, lpos)
[ô]Dim posicao1 As Integer
[ô]Dim posicao2 As Integer
Dim tamanho As Integer
Dim nPosCST1 As String
Dim nPosCST2 As String
Dim nPosBC1 As String
Dim nPosBC2 As String
Dim nPosPIS1 As String
Dim nPosPis2 As String
Dim nPosvPIS1 As String
Dim nPosvPIS2 As String
Dim nPosCof1 As String
Dim nPosCof2 As String
Dim nPosvCof1 As String
Dim nPosvCof2 As String
If lpos = 0 Then
lpos = 1
End If
posicao1 = InStr(lpos, sString, lpos1) [ô]saber qual a posicao que comeca por exemplo <cProd>
posicao2 = InStr(lpos, sString, lpos2) [ô]saber qual a posicao que comeca por exemplo </cProd>
If lpos1 = [Ô]<chNFe>[Ô] Then
posicao1 = posicao1 + 7
tamanho = posicao2 - posicao1 [ô]ver (<cProd> e </cProd>) a diferença para pegar o conteúdo nesse caso o código do Ãtem
Verifica_Conteudo = Mid(sString, posicao1, 44)
End If
If lpos1 = [Ô]<nNF>[Ô] Then
posicao1 = posicao1 + 5
tamanho = posicao2 - posicao1 [ô]ver (<cProd> e </cProd>) a diferença para pegar o conteúdo nesse caso o código do Ãtem
Verifica_Conteudo = Mid(sString, posicao1, tamanho)
End If
If lpos1 = [Ô]<dEmi>[Ô] Then
posicao1 = posicao1 + 6
tamanho = posicao2 - posicao1 [ô]ver (<cProd> e </cProd>) a diferença para pegar o conteúdo nesse caso o código do Ãtem
Verifica_Conteudo = Mid(sString, posicao1, tamanho)
End If
end sub
Private Function VerificaItempro(ByVal sTagPaiIni As String, ByVal sTagPaiFim As String, ByVal strResp As String) As String
On Error Resume Next
Dim lpos1 As Long, lpos2 As Long, lPos3 As Long, lPos4 As Long
[ô]VerificaItem = [Ô][Ô]
[ô]verificando valor do cStat resultante do web service a partir do final do código XML
lpos1 = InStrRev(strResp, sTagPaiIni) + Len(sTagPaiIni)
lpos2 = InStrRev(strResp, sTagPaiFim)
If lpos1 > Len(sTagPaiIni) And lpos2 > lpos1 Then
strResp = Mid(strResp, lpos1, lpos2 - lpos1)
VerificaItempro = strResp
[ô]gravar_txt strResp
Exit Function
End If
lpos1 = InStrRev(strResp, sTagPaiIni) + Len(sTagPaiIni)
lpos2 = InStrRev(strResp, [Ô]</det>[Ô])
If lpos1 > Len(sTagPaiIni) And lpos2 > lpos1 Then
strResp = Mid(strResp, lpos1, lpos2 - lpos1)
VerificaItempro = strResp
Exit Function
End If
End Function
Private Sub Separar_Item(sDesc)
Dim sPriPos As Integer
Dim sUltPos As Integer
Dim x As String
Dim nUlt As String
sChave = Verifica_Conteudo(sDesc, [Ô]<chNFe>[Ô], [Ô]</chNFe>[Ô], lpos)
end sub
*****COLOCAR EM UM MODULO
Option Explicit
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
Declare Function CallWindowProc Lib [Ô]user32[Ô] Alias [Ô]CallWindowProcA[Ô] (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib [Ô]user32[Ô] Alias [Ô]SetWindowLongA[Ô] (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib [Ô]shell32.dll[Ô] Alias [Ô]Shell_NotifyIconA[Ô] (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
[ô]Private TheData As NOTIFYICONDATA
Public TheData As NOTIFYICONDATA
[ô] -- Api SetForegroundWindow Para traer la ventana al frente
Private Declare Function SetForegroundWindow Lib [Ô]user32[Ô] (ByVal hWnd As Long) As Long
[ô][ô] -- Api para desplegar el cuadro de diálogo Acerca de ...
Private Declare Function ShellAbout Lib [Ô]shell32.dll[Ô] Alias [Ô]ShellAboutA[Ô] (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
[ô][ô] -- Constantes para los botones y le mouse (mensajes)
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
[ô]Private Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
[ô]Private Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
[ô] *********************************************
[ô] The replacement window proc.
[ô] *********************************************
Public Function NewWindowProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If msg = TRAY_CALLBACK Then
[ô] The user clicked on the tray icon.
[ô] Look for click events.
If lParam = WM_LBUTTONUP Then
[ô] On left click, show the form.
If TheForm.WindowState = vbMinimized Then _
TheForm.WindowState = TheForm.LastState
TheForm.SetFocus
[ô]Exit Function
End If
If lParam = WM_RBUTTONUP Then
[ô] On right click, show the menu.
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
[ô] Send other messages to the original
[ô] window proc.
If msg <> 133 Then
NewWindowProc = CallWindowProc( _
OldWindowProc, hWnd, msg, _
wParam, lParam)
End If
End Function
[ô] *********************************************
[ô] Add the form[ô]s icon to the tray.
[ô] *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
[ô] ShowInTaskbar must be set to False at
[ô] design time because it is read-only at
[ô] run time.
[ô] Save the form and menu for later use.
Set TheForm = frm
Set TheMenu = mnu
[ô] Install the new WindowProc.
OldWindowProc = SetWindowLong(frm.hWnd, _
GWL_WNDPROC, AddressOf NewWindowProc)
[ô] Install the form[ô]s icon in the tray.
With TheData
.uId = 0
.hWnd = frm.hWnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON
.ucallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
[ô] *********************************************
[ô] Remove the icon from the system tray.
[ô] *********************************************
Public Sub RemoveFromTray()
[ô] Remove the icon from the tray.
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData
[ô] Restore the original window proc.
SetWindowLong TheForm.hWnd, GWL_WNDPROC, _
OldWindowProc
End Sub
[ô] *********************************************
[ô] Set a new tray tip.
[ô] *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
[ô] *********************************************
[ô] Set a new tray icon.
[ô] *********************************************
Public Sub SetTrayIcon(pic As Picture)
[ô] Do nothing if the picture is not an icon.
If pic.Type <> vbPicTypeIcon Then Exit Sub
[ô] Update the tray icon.
With TheData
.hIcon = pic.Handle
.uFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
Segue um trecho que utilizado...
[ô]*** Importa o arquivo xml
Dim xmlDoc As New XmlDocument
xmlDoc.Load(W_ARQUIVO.Text)
Dim strxml As String = xmlDoc.InnerXml.ToString
[ô]*** Remove tags e nomespace ***
strxml = Replace(strxml, [Ô]<?xml version=[Ô][Ô]1.0[Ô][Ô] encoding=[Ô][Ô]UTF-8[Ô][Ô]?>[Ô], [Ô][Ô])
strxml = Replace(strxml, [Ô]xmlns=[Ô][Ô]http://www.portalfiscal.inf.br/nfe[Ô][Ô][Ô], [Ô][Ô])
strxml = Replace(strxml, [Ô]xmlns=[Ô][Ô]http://www.w3.org/2000/09/xmldsig#[Ô][Ô][Ô], [Ô][Ô])
[ô]*** Importa XML tratada sem tags e nomespace
Dim xDoc As New XmlDocument()
xDoc.LoadXml(strxml)
Using scope As New TransactionScope()
Try
[ô]*** Percorre a Estrutura do XML para a extração dos Dados ***
xNodeDest = xDoc.SelectSingleNode([Ô]nfeProc[Ô])
For Each xnfeProc As XmlNode In xNodeDest.ChildNodes
Select Case xnfeProc.Name
Case [Ô]NFe[Ô]
For Each xNFe As XmlNode In xnfeProc.ChildNodes
Select Case xNFe.Name
Case [Ô]infNFe[Ô]
For Each xInfNFe As XmlNode In xNFe.ChildNodes
Select Case xInfNFe.Name
Case [Ô]ide[Ô]
Case [Ô]NFref[Ô]
Case [Ô]emit[Ô]
Case [Ô]avulsa[Ô]
Case [Ô]dest[Ô]
Case [Ô]retirada[Ô]
Case [Ô]entrega[Ô]
Case [Ô]total[Ô]
Case [Ô]transp[Ô]
End Select
Next
Case [Ô]Signature[Ô]
End Select
Next
Case [Ô]protNFe[Ô]
End Select
Next
scope.Complete()
MessageBox.Show([Ô]XML importado![Ô], [Ô]Aviso[Ô], MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
MessageBox.Show([Ô]XML não importado![Ô] + vbCrLf + ex.Message, [Ô]Aviso[Ô], MessageBoxButtons.OK, MessageBoxIcon.Information)
End Try
End Using
Amigo, pegue um dos xmls, e abra o prompt de comando do visual studio. Grave o xml em uma pasta qualquer. No prompt de comando, digite:
xsd arquivo.xml
Isso vai criar um arquivo xsd(arquivo de esquema) do seu xml.
Depois digite:
xsd arquivo.xsd /classes
Isso vai criar um arquivo .cs com uma classe estruturada com o seu xml. Então simplesmente use serialização/desserialização dos xml para instâncias dessa classe.
Se quiser criar um arquivo [Ô].vb[Ô] ao invés de um [Ô].cs[Ô]:
xsd arquivo.xsd /classes /language:vb
xsd arquivo.xml
Isso vai criar um arquivo xsd(arquivo de esquema) do seu xml.
Depois digite:
xsd arquivo.xsd /classes
Isso vai criar um arquivo .cs com uma classe estruturada com o seu xml. Então simplesmente use serialização/desserialização dos xml para instâncias dessa classe.
Se quiser criar um arquivo [Ô].vb[Ô] ao invés de um [Ô].cs[Ô]:
xsd arquivo.xsd /classes /language:vb
Tópico encerrado , respostas não são mais permitidas