tof008
Messages postés695Date d'inscriptionjeudi 5 mai 2005StatutMembreDernière intervention 5 janvier 2010
-
11 déc. 2006 à 09:41
ShareVB
Messages postés2676Date d'inscriptionvendredi 28 juin 2002StatutMembreDernière intervention13 janvier 2016
-
11 déc. 2006 à 13:59
Bonjour à tous et joyeux lundi matin lol!
J'ai un petit problème (sinon, je ne posterai pas, c'est vrai ) : Je dois créer une dll. Alors je fais une nouveau projet Active X dll, j'y recopie ma classe et quand je veux crée la Dll je recois le message suivant : Variable uses an automation type not supported in Visual Basic. Pourtant j'ai coché toutes les réferences et je n'utilise pas de type particulier . Voila le code de ma classe :
Option Explicit
Dim xmlFic As New MSXML2.DOMDocument
Dim Sc As New ScriptControl
Dim nbArgument As Integer
Dim i As Integer
Public Function changeFonctionToXmlEnvoi(nomFonction As String, Optional att1 As Variant Null, Optional att2 As Variant Null, Optional att3 As Variant = Null, Optional att4 As Variant = Null, Optional att5 As Variant = Null, Optional att6 As Variant = Null, Optional att7 As Variant = Null, Optional att8 As Variant = Null, Optional att9 As Variant = Null, Optional att10 As Variant = Null)
'======================================================================================
'Le fichier xml qui sera crée grâce à cette fonction sera de cette forme :
' <?xml version="1.0" standalone="no" ?>
'- <TOKPAY>
' <response crypt="off" cryptver="0000" date="20/11/06" table="System" vers="V 0.1" nbPage="1" numéroPage="1" />
'- <f name="addCustomer">
' http://localhost/WebService1/Service1.asmx?WSDL "
End Function
Public Function changeToStringXml(fichierXML As MSXML2.DOMDocument)
'======================================================================================
'Fonction qui permet de changer un fichier xml en "string Xml"
'======================================================================================
Dim stringXml As String
stringXml = fichierXML.xml
changeToStringXml = stringXml
End Function
Public Function changeStringToXml(chaine As String)
'======================================================================================
'Fonction qui permet de changer du "StringXml" en XML
'======================================================================================
Dim fichier2 As New MSXML2.DOMDocument
fichier2.loadXML (chaine)
fichier2.save (App.Path & "\test2.xml")
End FunctionPublic Function changeFonctionToXmlReponse(nomFonction As String, Optional att1 As Variant Null, Optional att2 As Variant Null, Optional att3 As Variant = Null, Optional att4 As Variant = Null, Optional att5 As Variant = Null, Optional att6 As Variant = Null, Optional att7 As Variant = Null, Optional att8 As Variant = Null, Optional att9 As Variant = Null, Optional att10 As Variant = Null)
'======================================================================================
'On change la fonction "réponse" en fichier xml
'======================================================================================
'on declare les différents noeuds
Dim xRacine As IXMLDOMElement
Dim xResponse As IXMLDOMElement
Dim xfonction As IXMLDOMElement '
Dim xAttributs As IXMLDOMElement ' pour les champs fils de "fonction" dont on ne connaît pas le nombre
Dim tableauSeparer() As String
Set xmlFic = Nothing 'on initialise la structure du fichier
'======================================================================================
' on place un en-tête dans le fichier (avant le noeud racine)
' <?xml version="1.0" standalone ="no"?>
'======================================================================================
Dim xInstruction As IXMLDOMProcessingInstruction
Set xInstruction = xmlFic.createProcessingInstruction("xml", "version='1.0' standalone ='no'")
Call xmlFic.insertBefore(xInstruction, xmlFic.childNodes.Item(0))
'======================================================================================
' On crée le noeud racine dans le fichier. On le nomme "TOKPAY"
' (le fichier ne peut contenir qu'un seul noeud racine de niveau 1)'Set xRacine xmlFic.createElement("TOKPAY")
xmlFic.appendChild xRacine
' On se positionne sur le noeud de la racine "TOKPAY"
Set xRacine = xmlFic.selectSingleNode("TOKPAY")
' Pour y créer un fils "TOKPAY"
Set xResponse = xmlFic.createElement("response")
'On donne des attributs spécifiques à la balise xResponse
xResponse.setAttribute "crypt", "off"
xResponse.setAttribute "cryptver", "0000"
xResponse.setAttribute "date", Format$(Now, "dd/mm/yy")
xResponse.setAttribute "table", "System"
xResponse.setAttribute "vers", "V 0.1"
xResponse.setAttribute "nbPage", "1"
xResponse.setAttribute "numéroPage", "1"
xResponse.setAttribute "nbArguments", "" & nbArgument & ""
'xresponse est un fils de la racine "TOKPAY"
xRacine.appendChild xResponse
'======================================================================================
'On cpte le nombre d'arg et on les met ds un tableau pour pouvoir les écire ds le xml
'======================================================================================
Dim arg() As Variant
'nomF = nomFonction
ReDim arg(9) As Variant
If IsNull(att1) Then
i = 0
Else: arg(0) = att1
If IsNull(att2) Then
i = 1
Else: arg(1) = att2
If IsNull(att3) Then
i = 2
Else: arg(2) = att3
If IsNull(att4) Then
i = 3
Else: arg(3) = att4
If IsNull(att5) Then
i = 4
Else: arg(4) = att5
If IsNull(att6) Then
i = 5
Else: arg(5) = att6
If IsNull(att7) Then
i = 6
Else: arg(6) = att7
If IsNull(att8) Then
i = 7
Else: arg(7) = att8
If IsNull(att9) Then
i = 8
Else: arg(8) = att9
If IsNull(att10) Then
i = 9
Else: arg(9) = att10
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
MsgBox "nb argument : " & i & " nomFonction : " & nomFonction
'on recupere le nombre d'arguments de la fonction
nbArgument = i
'======================================================================================
' Creation du noeud fonction
'======================================================================================
' On se positionne sur le noeud de la racine "TOKPAY"
Set xRacine = xmlFic.selectSingleNode("TOKPAY")
' ---------------------------
' Pour y créer un fils "TOKPAY"
Set xfonction = xmlFic.createElement("f")
xfonction.setAttribute "name", "" & nomFonction & ""
xRacine.appendChild xfonction
'======================================================================================
' On crée un fils de "function"'i 0
'on boucle pour ajouter tous les attributs dans le fichier xml
While i < nbArgument
Set xAttributs = xmlFic.createElement("att") 'xmlFic.createElement ("att")
xAttributs.setAttribute "val", "" & arg(i) & ""
xAttributs.setAttribute "type", " variant "
xfonction.appendChild xAttributs
i = i + 1
Wend
' on écrit le fichier sur le disque
xmlFic.save App.Path & "\test2.xml"
MsgBox changeToStringXml(xmlFic)
Set xmlFic = Nothing
End Function
'======================================================================================
'Cette fonction servira à lire les fichiers xml envoyés en réponse
'======================================================================================
Public Function lireFichierXmlGene(fichier As DOMDocument30)
Dim tablo() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As String
ReDim tablo(100)
i = 0
k = 0
fichier.Load (App.Path & "" & "test.xml")
'on se place sur le noeud TOKPAY
If fichier.childNodes.Item(1).nodeName = "TOKPAY" Then
While i <> fichier.childNodes.Item(1).childNodes.length
m = fichier.childNodes.Item(1).childNodes.Item(j).nodeName
MsgBox "fils = " + m
'on evite le noeud response
If m <> "response" Then
tablo(k) = fichier.childNodes.Item(1).childNodes.Item(j).Text
MsgBox tablo(k)
k = k + 1
End If
j = j + 1
i = i + 1
Wend
End If
MsgBox "fichier parcouru"
lireFichierXmlGene = tablo()
End Function
(Si la réponse vous convient, appuyez sur réponse acceptée...).
ShareVB
Messages postés2676Date d'inscriptionvendredi 28 juin 2002StatutMembreDernière intervention13 janvier 201626 11 déc. 2006 à 13:59
salut,
à priori ca doit venir de MSXML2 et plus particulièrement des New...essaies de les remplacer par un createobject...sinon regarde et commente utilisation de chaque type Ixxx et DOMxxx pour voir d'où vient le problème...il peut arriver qu'une dll expose des choses comme des entiers non signés ou des pointeurs dans des structures...que VB6 n'aime pas du tout...
