Problème éléments vides dans du XML sous VB6

Salut à tous

Voilà, je voudrais que lorsque j'entre un élément vide, le xml m'indique :

<ele/> et non pas <ele></ele>

Voilà une partie du code que j'utilise :
la 1er fonction lancée est AjouterPatient()

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
Public mDom As DOMDocument40
 
Public Function AjouterPatient(patient As PatientType) As Boolean
Dim xmlPatientelle As IXMLDOMElement
Dim xmlPatient As IXMLDOMElement
Dim xmlDateNaissance As IXMLDOMElement
Dim xmlTelephone As IXMLDOMElement
Dim xmlTelephone1 As IXMLDOMElement
Dim xmlTelephone2 As IXMLDOMElement
Dim xmlTelephone3 As IXMLDOMElement
Dim xmlAssure As IXMLDOMElement
Dim xmlOrganisme As IXMLDOMElement
Dim xmlAdresse As IXMLDOMElement
 
''
Set mDom = New MSXML2.DOMDocument40
 
mDom.appendChild mDom.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
Set xmlPatientelle = AjouterElement("Patientelle", mDom)
'''
AjouterPatient = False
 
'Set xmlPatientelle = mDom.selectSingleNode("Patientelle")   ' positionnement sur la racine
 
Set xmlPatient = AjouterElement("Patient", xmlPatientelle)
 
AjouterElement("ID", xmlPatient).Text = patient.ID
AjouterElement("Nom", xmlPatient).Text = patient.Nom
AjouterElement("Prenom", xmlPatient).Text = patient.Prénom
AjouterElement("Sexe", xmlPatient).Text = patient.Sexe
AjouterElement("NumSS", xmlPatient).Text = patient.NumSS
 
Set xmlDateNaissance = AjouterElement("DateNaissance", xmlPatient)
AjouterElement("Jour", xmlDateNaissance).Text = patient.DateNaissance.Jour
AjouterElement("Mois", xmlDateNaissance).Text = patient.DateNaissance.Mois
AjouterElement("Annee", xmlDateNaissance).Text = patient.DateNaissance.Année
 
Set xmlTelephone = AjouterElement("Telephone", xmlPatient)
Set xmlTelephone1 = AjouterElement("TelephoneA", xmlTelephone)
AjouterElement("Numero", xmlTelephone1).Text = patient.Telephone(1).Numero
AjouterElement("Qui", xmlTelephone1).Text = patient.Telephone(1).Qui
Set xmlTelephone2 = AjouterElement("TelephoneB", xmlTelephone)
AjouterElement("Numero", xmlTelephone2).Text = patient.Telephone(2).Numero
AjouterElement("Qui", xmlTelephone2).Text = patient.Telephone(2).Qui
Set xmlTelephone3 = AjouterElement("TelephoneC", xmlTelephone)
AjouterElement("Numero", xmlTelephone3).Text = patient.Telephone(3).Numero
AjouterElement("Qui", xmlTelephone3).Text = patient.Telephone(3).Qui
 
Set xmlAssure = AjouterElement("Assure", xmlPatient)
AjouterElement("Nom", xmlAssure).Text = patient.Assuré.Nom
AjouterElement("Prenom", xmlAssure).Text = patient.Assuré.Prénom
AjouterElement("NumSS", xmlAssure).Text = patient.Assuré.NumSS
 
Set xmlOrganisme = AjouterElement("Organisme", xmlAssure)
AjouterElement("Nom", xmlOrganisme).Text = patient.Assuré.Organisme.Nom
AjouterElement("Code", xmlOrganisme).Text = patient.Assuré.Organisme.Code
 
Set xmlAdresse = AjouterElement("Adresse", xmlAssure)
AjouterElement("Rue", xmlAdresse).Text = patient.Assuré.Adresse.Rue
AjouterElement("CP", xmlAdresse).Text = patient.Assuré.Adresse.CP
AjouterElement("Ville", xmlAdresse).Text = patient.Assuré.Adresse.Ville
 
 
End Function
Public Function ChargerXML()
 
Set mDom = New MSXML2.DOMDocument40
 
' Chargement du document XML
 
mDom.async = False ' permet de charger entièrement le document en mémoire avant le traitement
 
If mDom.Load(App.Path & "\Sauve\patient.xml") = False Then
    MsgBox "Erreur de lecture du document XML"
    End
End If
 
End Function
 
 
Public Function AjouterElement(ByVal Name As String, ByRef ElementParent As IXMLDOMNode, Optional ByRef InsertBefore As IXMLDOMNode = Nothing) As IXMLDOMElement
  'Ajouter un élément dans le document DOM
 
  Set AjouterElement = mDom.createNode(NODE_ELEMENT, Name, "")
  ElementParent.InsertBefore AjouterElement, InsertBefore
End Function
 
Public Function SauverXML()
  'Indente le XML qui sinon est sur une seule ligne
 
  Dim NbIndent                      As Integer
  Dim Pos                           As Long
  Dim Xml                           As String
 
 
  Xml = mDom.Xml
  NbIndent = 0
  Pos = InStr(Xml, "><")
  Do While Pos <> 0
    Change = True
    If Mid(Xml, Pos - 1, 1) = "/" Then
      If Mid(Xml, Pos + 2, 1) = "/" Then
        '/></
        NbIndent = NbIndent - 1
      Else
        '/><
        NbIndent = NbIndent
      End If
    Else
      If Mid(Xml, Pos + 2, 1) = "/" Then
        '></
 
        'Regarde si le node est une basile de fin ex: "</NodeInfo>"
        Pos = InStrRev(Xml, "<", Pos)
        Select Case Mid(Xml, Pos + 1, 1)
        Case "/", "!"
          '</NodeInfo></Created>
          'ou
          '<!-- C'est un commentaire
            NbIndent = NbIndent - 1
        Case Else
          '<AuditPool></AuditPool>
          NbIndent = NbIndent
        End Select
        'NbIndent = NbIndent - 1
      Else
        '><
 
        'Regarde si le node est une basile de fin ex: "</NodeInfo>"
        Pos = InStrRev(Xml, "<", Pos)
        Select Case Mid(Xml, Pos + 1, 1)
        Case "/", "!"
          '</NodeInfo><Created>
          'ou
          '<!-- C'est un commentaire
            NbIndent = NbIndent
        Case Else
          '<AuditPool><Created>
          NbIndent = NbIndent + 1
        End Select
      End If
    End If
    Xml = Replace(Xml, "><", ">" & vbCrLf & String(NbIndent, vbTab) & "<", , 1)
 
    Pos = InStr(Xml, "><")
    DoEvents
  Loop
  Open App.Path & "\Sauve\patient.xml" For Output As #1
  Print #1, Xml
  Close #1
 
End Function

Si une des valeurs que j'ajoute est vide (String de longueur nulle), alors il ne m'indique pas un élément vide dans le résultat que voici :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
 
<?xml version="1.0"?>
<Patientelle>
	<Patient>
		<ID>1</ID>
		<Nom>
		</Nom>
		<Prenom>
		</Prenom>
		<Sexe>0</Sexe>
		<NumSS>0</NumSS>
		<DateNaissance>
			<Jour>0</Jour>
			<Mois>0</Mois>
			<Annee>0</Annee>
		</DateNaissance>
		<Telephone>
			<TelephoneA>
				<Numero>0</Numero>
				<Qui>
				</Qui>
			</TelephoneA>
			<TelephoneB>
				<Numero>0</Numero>
				<Qui>
				</Qui>
			</TelephoneB>
			<TelephoneC>
				<Numero>0</Numero>
				<Qui>
				</Qui>
			</TelephoneC>
		</Telephone>
		<Assure>
			<Nom>
			</Nom>
			<Prenom>
			</Prenom>
			<NumSS>0</NumSS>
			<Organisme>
				<Nom>
				</Nom>
				<Code>0</Code>
			</Organisme>
			<Adresse>
				<Rue>Rue</Rue>
				<CP>0</CP>
				<Ville>Ville</Ville>
			</Adresse>
		</Assure>
	</Patient>
</Patientelle>

tes champs ne doivent pas être "vide.." j'ai pas le problème avec le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Dim xmlDoc As New DOMDocument40
Private Sub Command1_Click()
'Create a DOMDocument object.
 
'Create the reader.
Dim rdr As New SAXXMLReader40
'Create the writer.
Dim wrt As New MXXMLWriter40
 
Dim xmlPatientelle As IXMLDOMElement
Dim xmlPatient As IXMLDOMElement
'Load the DOM document.
xmlDoc.async = False
 
xmlDoc.appendChild xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
Set xmlPatientelle = AjouterElement("Patientelle", xmlDoc)
Set xmlPatient = AjouterElement("Patient", xmlPatientelle)
AjouterElement("ID", xmlPatient).Text = "MonID"
AjouterElement("Nom", xmlPatient).Text = ""
AjouterElement("Prenom", xmlPatient).Text = ""
AjouterElement("Sexe", xmlPatient).Text = "M"
 
'----- Indentation -----
'Set properties on the XML writer.
wrt.byteOrderMark = True
wrt.omitXMLDeclaration = False
wrt.indent = True
 
'Set the XML writer to the SAX content handler.
Set rdr.contentHandler = wrt
Set rdr.dtdHandler = wrt
Set rdr.errorHandler = wrt
 
'Parse the DOMDocument object.
rdr.parse xmlDoc
 
xmlDoc.loadXML wrt.output
xmlDoc.save "d:\users\NewXML.xml"
End Sub
Public Function AjouterElement(ByVal Name As String, ByRef ElementParent As IXMLDOMNode, Optional ByRef InsertBefore As IXMLDOMNode = Nothing) As IXMLDOMElement
  'Ajouter un élément dans le document DOM
 
  Set AjouterElement = xmlDoc.createNode(NODE_ELEMENT, Name, "")
  ElementParent.InsertBefore AjouterElement, InsertBefore
End Function

le résultat :

Code:

1
2
3
4
5
6
7
8
9
10
 
<?xml version="1.0" standalone="no"?>
<Patientelle>
	<Patient>
		<ID>MonID</ID>
		<Nom/>
		<Prenom/>
		<Sexe>M</Sexe>
	</Patient>
</Patientelle>

pour l'indentation ... je préfère la méthode à OhMonBato :

;)

Merci bbil

Je teste ça...

Citation:

Envoyé par bbil

pour l'indentation ... je préfère la méthode à OhMonBato :

;)

C'est vrai que cette méthode fait plus pro (moins bidouille que la mienne...).
Je la mets de côté pour l'utiliser à partir de maintenant.

En effet, impeccable

Merci