FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
  
var 
UnNoeud : IXMLNode; 
Feuille : IXMLNode; 
begin 
  XMLDoc.Active := True; 
  
  //On crée un noeud 
  UnNoeud := XMLDoc.CreateNode('QR', ntElement); 
  //on crée une feuille. La balise correspondante à celle-ci est donnée 
  Feuille := XMLDoc.CreateElement('Donnee', ''); 
  //On donne une valeur à la feuille 
  Feuille.NodeValue := 'Rien';  
  //On ajoute la feuille dans le noeud 
  UnNoeud.ChildNodes.Add(Feuille);  
  
  //On ajoute le noeud dans la hiérarchie de notre document 
  XMLDoc.DocumentElement.ChildNodes.Add(UnNoeud);  
  
  //Pour être sûr que le code a été correctement exécuté 
  ShowMessage(XMLDoc.XML.Text);  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
  
var 
  Feuille : IXMLNode; 
begin 
  XMLDoc.Active := True; 
  
  Feuille := XMLDoc.CreateElement('Donnee', ''); 
  Feuille.NodeValue := 'Rien'; 
  
  //Le nœud est inséré dans une queue de collection 
  XMLDoc.DocumentElement.AddChild('Nouveau');  
  XMLDoc.DocumentElement.ChildNodes.Last.ChildNodes.Add(Feuille); 
end;

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
procedure TFrmTreeviewXML.LoadXMLInTree(XMLNode: IXMLNode; TreeNode: TTreeNode); 
var 
I: Integer; 
Noeud : TTreeNode; 
TexteDuNoeud: string; 
AttributNoeud: IXMLNode; 
begin 
//Les nœuds internes sont traités récursivement 
if XMLNode.NodeType <> ntElement then 
Exit; 
  
//On ajoute le nœud courant 
TexteDuNoeud := XmlNode.NodeName; 
  
//S'il s'agit d'une feuille 
if XMLNode.IsTextElement then 
TexteDuNoeud := TexteDuNoeud + ' = ' + XMLNode.NodeValue; 
  
Noeud := TvXML.Items.AddChild(TreeNode, TexteDuNoeud); 
  
//S'il y a des attributs on les ajoute... 
for I := 0 to XMLNode.AttributeNodes.Count - 1 do 
begin 
AttributNoeud := XMLNode.AttributeNodes.Nodes[I]; 
TvXML.Items.AddChild(Noeud,'[' + AttributNoeud.NodeName + ' = "' + AttributNoeud.Text + '"]'); 
end; 
  
//si le nœud courant a des nœuds enfants, on les ajoute 
  
if XMLNode.HasChildNodes then 
for I := 0 to XMLNode.ChildNodes.Count - 1 do 
LoadXMLInTree(XMLNode.ChildNodes.Nodes [I], Noeud); 
end;

1
2
3
4
5
6
7
8
9
10
procedure TFrmTreeviewXML.BtnLoadClick(Sender: TObject); 
begin 
//On efface le contenu du TreeView 
TvXML.Items.Clear; 
XMLDoc.Active := True; 
//Pour éviter le scintillement avec les gros fichiers... 
TvXML.Items.BeginUpdate; 
LoadXMLInTree(XMLDoc.DocumentElement, nil); 
TvXML.Items.EndUpdate; 
end;

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
(*Supprimer les commentaires pour afficher les messages appropriés*) 
function IsXMLWellFormed(XMLFileName : String) : Boolean; 
var 
ParseError: IDOMParseError;//Interface permettant de recupérer les erreurs dans le xml 
FileContent : TStringList; //Pour stocker le contenu du fichier 
begin 
Result := False; 
  
//Une simple vérification d'extension 
if UpperCase(ExtractFileExt(XMLFileName)) <> UpperCase('.xml') then 
begin 
MessageDlg('Extension de fichier incorrecte!', mtError, [mbOK], 0); 
Exit; 
end; 
  
//Ouverture du document : On doit l'ouvrir pour que le parser puisse interpréter son contenu 
XMLDoc.Active := True; 
FileContent := TStringList.Create; 
  
(* 
TXMLDocument implémente l'interface IXMLDocumentAccess qui nous permet d'accéder  aux 
propriétés protégées de TXMLDocument (une en particulier, DOMPersist est utilisée 
dans le code pour charger le contenu du fichier xml) 
*) 
  
try 
try 
FileContent.LoadFromFile(XMLFileName); 
(XMLDoc as IXMLDocumentAccess).DOMPersist.LoadXML(FileContent.Text); 
finally 
FileContent.Free; 
end; 
except 
on E : Exception do 
begin 
//ShowMessage(E.Message); 
Exit; 
end; 
end; 
  
ParseError := (XMLDoc.DOMDocument as IDOMParseError); 
if ParseError.ErrorCode <> 0 then 
with ParseError do 
begin 
//MessageDlg('Erreur à la ligne ' + IntToStr(Line) + 'Position ' + IntToStr(linePos) + 
//#13#10 + Reason, mtError, [mbOK], 0); 
Exit; 
end; 
  
Result := True; 
//MessageDlg('Document bien formé!', mtInformation, [mbOK], 0); 
end;

Noeud := XMLDocument1.ChildNodes['RACINE'].ChildNodes['MonNoeud'];

1
2
3
4
5
6
7
8
9
10
11
12
function XMLNodeValue(Noeud : IXMLNode; DefaultValue : string) : string; 
begin 
  if assigned(noeud) then 
    try 
      if not VarIsNull(noeud.NodeValue) then Result := noeud.NodeValue 
      else Result := DefaultValue; 
    except 
      Result := DefaultValue; 
    end 
  else 
    result := DefaultValue;  
end;

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
unit UXMLvalidation; 
  
interface 
  
uses 
  Classes, SysUtils, msxmldom,  
  MSXML2_TLB, { Il faut importer l'activeX MSXML DOM2 4.0 pour obtenir l'unité MSXML2_TLB.pas }  
  xmldom,  
  XMLDoc, XMLIntf; { Pour une utilisation de TXMLDocument } 
  
type 
  EXMLDOMValidationError = class(Exception) 
  private 
    FSrcText: DOMString; 
    FURL: DOMString; 
    FReason: DOMString; 
    FErrorCode: Integer; 
    FLine: Integer; 
    FLinePos: Integer; 
    FFilePos: Integer; 
  public 
    constructor Create(const ValidationError: IXMLDOMParseError); 
    property ErrorCode: Integer read FErrorCode; 
    property URL: DOMString read FURL; 
    property Reason: DOMString read FReason; 
    property SrcText: DOMString read FSrcText; 
    property Line: Integer read FLine; 
    property LinePos: Integer read FLinePos; 
    property FilePos: Integer read FFilePos; 
  end; 
  
  
procedure ValidateXMLFileName(XMLFilename,  XSDFilename: TFileName; NameSpaceSchema: string); 
procedure ValidateXMLText(XMLText: string; XSDFilename: TFileName; NameSpaceSchema: string); 
procedure ValidateXMLDoc(XMLDoc, XSDDoc: IXMLDOMDocument2;   NameSpaceSchema: string); 
  
// Génère une exception EXMLDOMValidationError si errorcode<>0 
procedure CheckValidationError(ValidationError: IXMLDOMParseError); 
  
// Permet de retrouver l'interface COM de MSXML à partir d'un IXMLDocument (Borland) 
// Attention: le IXMLDocument doit avoir dans ce cas MSXML comme Vendor ! 
function GetXMLDOMDocument2(XMLDoc: IXMLDocument): IXMLDOMDocument2; 
  
resourcestring 
  RS_EXMLDOM_FILE_VALIDATION_ERROR = 'Document XML non conforme au schéma.'#13#10#13#10+ 
    'Raison:'#13#10'%s'#13#10+ 
    'Ligne: %d'#13#10+ 
    'Position: %d'#13#10+ 
    'Position dans le fichier: %d'#13#10+ 
    'URL: %s'#13#10+ 
    'XML: '#13#10'%s'; 
  
  RS_EXMLDOM_NOFILE_VALIDATION_ERROR = 'Document XML non conforme au schéma.'#13#10#13#10+ 
      'Raison:'#13#10'%s'#13#10; 
  
implementation 
  
{ EXMLDOMValidationError } 
  
constructor EXMLDOMValidationError.Create( 
  const ValidationError: IXMLDOMParseError); 
begin 
  FSrcText := ValidationError.srcText; 
  FURL := ValidationError.url; 
  FReason := ValidationError.reason; 
  FErrorCode := ValidationError.errorCode; 
  FLine := ValidationError.line; 
  FLinePos := ValidationError.linepos; 
  FFilePos := ValidationError.filepos; 
  
  if FLine>0 then 
    inherited CreateResFmt(@RS_EXMLDOM_FILE_VALIDATION_ERROR, [FReason, 
      FLine, 
      FLinePos, 
      FFilePos, 
      FURL, 
      FSrcText]) 
  else 
    inherited CreateResFmt(@RS_EXMLDOM_FILE_VALIDATION_ERROR, [FReason]); 
end; 
  
function GetXMLDOMDocument2(XMLDoc: IXMLDocument): IXMLDOMDocument2; 
begin 
  XMLDoc.Active := True; 
  Result := ((XMLDoc.DOMDocument as IXMLDOMNodeRef).GetXMLDOMNode as IXMLDOMDocument2); 
end; 
  
procedure CheckValidationError(ValidationError: IXMLDOMParseError); 
begin 
  if ValidationError.errorCode<>0 then 
    raise EXMLDOMValidationError.Create(ValidationError); 
end; 
  
procedure ValidateXMLDoc(XMLDoc, XSDDoc: IXMLDOMDocument2; 
  NameSpaceSchema: string); 
var 
  vSchemaCollection: IXMLDOMSchemaCollection2; 
begin 
  vSchemaCollection := CoXMLSchemaCache40.Create; 
  vSchemaCollection.add(NameSpaceSchema, XSDDoc); 
  XMLDoc.schemas := vSchemaCollection; 
  CheckValidationError(XMLDoc.validate); 
end; 
  
procedure ValidateXMLFilename(XMLFilename, 
  XSDFilename: TFileName; NameSpaceSchema: string); 
var 
  vXML, 
  vSchema: IXMLDOMDocument2; 
  vSchemaCollection: IXMLDOMSchemaCollection2; 
begin 
  vSchema := CoDOMDocument40.Create; 
  vSchema.async := False; 
  vSchema.load(XSDFilename); 
  
  vSchemaCollection := CoXMLSchemaCache40.Create; 
  vSchemaCollection.add(NameSpaceSchema, vSchema); 
  
  vXML := CoDOMDocument40.Create; 
  vXML.async := False; 
  vXML.validateOnParse := True; 
  vXML.schemas := vSchemaCollection; 
  vXML.load(XMLFilename); 
  
  CheckValidationError(vXML.parseError); 
end; 
  
procedure ValidateXMLText(XMLText: string; 
  XSDFilename: TFileName; NameSpaceSchema: string); 
var 
  vXML, 
  vSchema: IXMLDOMDocument2; 
  vSchemaCollection: IXMLDOMSchemaCollection2; 
begin 
  vSchema := CoDOMDocument40.Create; 
  vSchema.async := False; 
  vSchema.load(XSDFilename); 
  
  vSchemaCollection := CoXMLSchemaCache40.Create; 
  vSchemaCollection.add(NameSpaceSchema, vSchema); 
  
  vXML := CoDOMDocument40.Create; 
  vXML.async := False; 
  vXML.validateOnParse := True; 
  vXML.schemas := vSchemaCollection; 
  vXML.loadXML(XMLText); 
  
  CheckValidationError(vXML.parseError); 
end; 
  
end.

1
2
3
4
5
<Root>  
      <AAA>Hello World</AAA>  
      <BBB name="Big"/>  
      <CCC name="test">Xml Mappeur</CCC>  
</Root>

1
2
3
4
5
6
7
8
9
10
11
12
<DATAPACKET Version="2.0">  
    <METADATA>  
      <FIELDS>  
      <FIELD attrname="AAA" fieldtype="string" WIDTH="11"/>  
      <FIELD attrname="BBB_name" fieldtype="string" WIDTH="3"/>  
      <FIELD attrname="CCC" fieldtype="string" WIDTH="11"/>  
      <FIELD attrname="CCC_name" fieldtype="string" WIDTH="3"/>  
      </FIELDS>  
      <PARAMS/>  
    </METADATA>  
    <ROWDATA/>  
</DATAPACKET>

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
function GetNode(XmlNode : IXmlNode;NodeName : String) : IXmlNode; 
var 
i : integer; 
begin 
  Result := nil; 
  
//Les nœuds internes sont traités récursivement 
  if XMLNode.NodeType <> ntElement then 
    Exit; 
  
  //S'il s'agit d'une feuille 
  if XMLNode.IsTextElement then 
    if UpperCase(XmlNode.NodeName) = UpperCase(NodeName) then 
    begin 
      Result := XmlNode; 
      Exit; 
    end; 
  // S'il s'agit d'un attribut 
  for i := 0 to XMLNode.AttributeNodes.Count - 1 do 
    if UpperCase(XMLNode.AttributeNodes.Nodes[I].NodeName) = Uppercase(NodeName) then 
    begin 
      Result := XMLNode.AttributeNodes.Nodes[I]; 
      Exit; 
    end; 
  
  // Si le nœud a des enfants on recherche dedans. 
  if XMLNode.HasChildNodes then 
    for I := 0 to XMLNode.ChildNodes.Count - 1 do 
    begin 
      Result := GetNode(XmlNode.ChildNodes.Nodes[I],NodeName); 
      // si on a un resultat on quitte car c'est celui qu'on recherche 
      if Result <> nil then 
Exit; 
    end; 
end;

1
2
3
4
5
6
7
var 
  Noeud : IXmlNode; 
begin 
  Noeud := GetNode(XmlDoc.DocumentElement,'MonNoeud'); 
  if Assigned(Noeud) then 
    Showmessage(La valeur de ' + Noeud.NodeName + ' est de ' + Noeud.Text); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
function FusionXMLXSL(sXML, sXSL: string): string; 
var 
  XMLDoc1 : TXMLDocument; 
  XSLPageProd1: TXSLPageProducer; 
begin 
  Result := '' ; 
  try 
    XMLDoc1 := TXMLDocument.Create(Self); 
    XMLDoc1.DOMVendor := DOMVendors.Find ('MSXML'); 
    XSLPageProd1 := TXSLPageProducer.Create(Self); 
    XSLPageProd1.DOMVendor := DOMVendors.Find ('MSXML'); 
    XMLDoc1.LoadFromXML(sXML); 
    XSLPageProd1.XMLData := XMLDoc1; 
    XSLPageProd1.XML.text := sXSL; 
    Result := XSLPageProd1.Content; 
  finally 
    if (XMLDoc1 <> Nil) then XMLDoc1.Free; 
    if (XSLPageProd1 <> Nil) then XSLPageProd1.Free; 
  end; 
end;