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
| //------------------------------------------------------------------------------
function TFM_MAJCOURSOR.TrouverPariteEuroDollar(const ADateCours:TDate; out APariteEuroDollar: Currency): Boolean;
function SelectManualNode(AXMLDocIntf: IXMLDocument; const ALevel2Criterion, ALevel3Criterion: string): IDOMNode;
const
LEVEL_0 = 'Envelope';
LEVEL_1 = 2; // Par son nom Cube, il semble confondre le Noeuds et sous-Noeuds
LEVEL_2 = 'Cube';
LEVEL_2_CRITERION = 'time';
LEVEL_3 = 'Cube';
LEVEL_3_CRITERION = 'currency';
var
NodeL0, NodeL1, NodeL2, NodeL3: IXMLNode;
begin
// Structure codé en dur !
NodeL0 := AXMLDocIntf.Node.ChildNodes.Nodes[LEVEL_0];
NodeL1 := NodeL0.ChildNodes.Nodes[LEVEL_1];
NodeL2 := NodeL1.ChildNodes.Nodes[LEVEL_2];
if NodeL2.Attributes[LEVEL_2_CRITERION] = ALevel2Criterion then
begin
NodeL3 := NodeL2.ChildNodes.Nodes[LEVEL_3];
if NodeL3.Attributes[LEVEL_3_CRITERION] = ALevel3Criterion then
Result := NodeL3.DOMNode;
end;
end;
const
URL_BCE_WS_XML = 'http://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml';
// Pour gérer le namespace et éviter l'erreur "Erreur d'exécution '-2147467259(80004005) ': une référence pour le préfixe d'espace de noms non déclaré: '< Préfixe d'espace de Noms >' "
// la fonction local-name() permet de trouver le noeud Envelope même si il est exprimé avec son namespace gesmes sous la forme gesmes:Envelope
// la constante XPATH_PARITY_FMT est une variante complexe mais fonctionnelle car la forme simple ne fonctionne pas '/Envelope/Cube/Cube[@time="%s"]/Cube[@currency="%s"]';
XPATH_PARITY_FMT = '/*[local-name()="Envelope"]/*[local-name()="Cube"]/*[local-name()="Cube" and @time="%s"]/*[local-name()="Cube" and @currency="%s"]';
USDOLLAR = 'USD';
CUBE_FMT = 'YYYY-MM-DD';
PARITY_ATTRIBUTE_NAME = 'rate';
XML_DECIMAL_SEPARATOR = '.';
var
HTTPGetter: TIdHTTP;
HTTPXMLStream: TMemoryStream;
XMLDocIntf: IXMLDocument;
DomNodeSelectIntf : IDomNodeSelect;
XPath: string;
DOMNodeCubeIntf, DOMNodeParityIntf: IDOMNode;
XMLFormatSettings: TFormatSettings;
BatchMsg, BatchMsgXML: string;
begin
Result := False;
APariteEuroDollar := 0;
// Utilisation d'un WebService renvoyé un fichier XML
HTTPGetter := TIdHTTP.Create();
try
HTTPXMLStream := TMemoryStream.Create();
try
try
HTTPGetter.Get(URL_BCE_WS_XML, HTTPXMLStream);
XMLDocIntf := TXMLDocument.Create(nil);
try
XMLDocIntf.LoadFromStream(HTTPXMLStream);
XMLDocIntf.Active := True;
if Assigned(XMLDocIntf.DOMDocument) and Supports(XMLDocIntf.DOMDocument, IDomNodeSelect, DomNodeSelectIntf) then
begin
try
// Récupère le taux de change fixé la veille, normalement c'est AVANT midi
// La BCE semble changer son cours vers 14h !
XPath := Format(XPATH_PARITY_FMT, [FormatDateTime(CUBE_FMT, ADateCours-1), USDOLLAR]);
DOMNodeCubeIntf := DomNodeSelectIntf.selectNode(XPath);
// Si on n'a pas le cours de la veille, on a peut-être celui du jour !
if not Assigned(DOMNodeCubeIntf) then
begin
XPath := Format(XPATH_PARITY_FMT, [FormatDateTime(CUBE_FMT, ADateCours), USDOLLAR]);
DOMNodeCubeIntf := DomNodeSelectIntf.selectNode(XPath);
end
except
on E: Exception do
begin
AddToLogFile(ChangeFileExt(ParamStr(0), '.log') , 'Lecture manuelle du XML car selectNode inopérant');
DOMNodeCubeIntf := SelectManualNode(XMLDocIntf, FormatDateTime(CUBE_FMT, ADateCours-1), USDOLLAR);
if not Assigned(DOMNodeCubeIntf) then
DOMNodeCubeIntf := SelectManualNode(XMLDocIntf, FormatDateTime(CUBE_FMT, ADateCours), USDOLLAR);
// if not Assigned(DOMNodeCubeIntf) then
// raise;
end;
end;
if Assigned(DOMNodeCubeIntf) then
begin
DOMNodeParityIntf := DOMNodeCubeIntf.attributes.getNamedItem(PARITY_ATTRIBUTE_NAME);
if Assigned(DOMNodeParityIntf) then
begin
// D'abord, on tente le format local de séparateur décimal (cela devrait être celui de la France donc virgule)
Result := TryStrToCurr(DOMNodeParityIntf.nodeValue, APariteEuroDollar);
// Si le format local ne passe pas, on utilise celui observé durant le développement en mars 2015, cad le point !
if not Result and (FormatSettings.DecimalSeparator <> XML_DECIMAL_SEPARATOR) then
begin
XMLFormatSettings := TFormatSettings.Create();
XMLFormatSettings.DecimalSeparator := XML_DECIMAL_SEPARATOR;
Result := TryStrToCurr(DOMNodeParityIntf.nodeValue, APariteEuroDollar, XMLFormatSettings);
end;
end
else
BatchMsg := 'ERREUR : Document XML incomplet - valeur de parité non trouvée !';
end
// Pas de cours trouvé pour la date
else
begin
AddToLogFile(ChangeFileExt(ParamStr(0), '.log') , Format('ERREUR : Document XML pas à jour - parité dollar non trouvée au %s !', [FormatDateTime(CUBE_FMT, ADateCours-1)]));
Exit;
end;
end
else
BatchMsg := 'ERREUR : Document XML invalide';
// Une alerte uniquement en mode Batch
if not Result and FModeSilent then
begin
XMLDocIntf.Options := [doNodeAutoIndent];
XMLDocIntf.SaveToXML(BatchMsgXML);
end;
finally
XMLDocIntf := nil;
end;
except
on E: Exception do
begin
BatchMsg := Format('Exception %s durant TrouverPariteEuroDollar : "%s"', [E.ClassName(), E.Message]);
OutputDebugString(PChar(BatchMsg));
BatchAlert(BatchMsg, BatchMsgXML);
Exit();
end;
end;
finally
HTTPXMLStream.Free();
end;
finally
HTTPGetter.Free();
end;
if not Result then
BatchAlert(BatchMsg, BatchMsgXML);
end; |
Partager