AresBasic
Ukázka přístupu do XML rozhraní IS ARES
Popis
declare function GetAsciiCharByDec dll "ActualDocument" (integer): string declare function HttpCreate dll "ScriptEx" (string): integer declare procedure HttpFree dll "ScriptEx" (var integer) declare function HttpGetIntegerProp dll "ScriptEx" (integer, string): integer declare function HttpGetStringProp dll "ScriptEx" (integer, string): string declare procedure HttpSetBooleanProp dll "ScriptEx" (integer, string, boolean) declare procedure HttpSetIntegerProp dll "ScriptEx" (integer, string, integer) declare procedure HttpSetStringProp dll "ScriptEx"(integer, string, string) declare procedure HttpRequestAddQueryParam dll "ScriptEx" (integer, string, string) declare function HttpConnectionSendRequest dll "ScriptEx" (integer, integer): integer declare function DomCreateDocument dll "ScriptEx" (integer, string, string, integer): integer declare procedure DomFree dll "ScriptEx" (var integer) declare function DomGetIntegerProp dll "ScriptEx" (integer, string): integer declare function DomGetStringProp dll "ScriptEx" (integer, string): string declare procedure DomSetStringProp dll "ScriptEx" (integer, string, string) declare function DomEvaluate dll "ScriptEx" (integer, string, integer, integer, integer, integer): integer declare function LastErrorGetCode dll "ScriptEx" (): integer declare function LastErrorGetMessage dll "ScriptEx" (): string script AresBasic(): boolean var CRLF: string Connection: integer Request: integer Response: integer StatusCode: integer Body: string Document_: integer XPathResult: integer Node: integer S: string Name: string Address: string PostalCode: string City: string Cin: string // IČO Tin: string // DIČ Error: string begin CRLF := GetAsciiCharByDec(13) + GetAsciiCharByDec(10) Connection := HttpCreate("THttpConnection") HttpSetStringProp(Connection, "Host", "wwwinfo.mfcr.cz") HttpSetBooleanProp(Connection, "Secure", true) HttpSetIntegerProp(Connection, "Port", 443) Request := HttpCreate("THttpRequest") HttpSetStringProp(Request, "Method", "GET") HttpSetStringProp(Request, "Path", "cgi-bin/ares/darv_bas.cgi") HttpRequestAddQueryParam(Request, "ico", "07760922") // Leviom data s.r.o. Response := HttpConnectionSendRequest(Connection, Request) if Response <> 0 then StatusCode := HttpGetIntegerProp(Response, "StatusCode") Body := HttpGetStringProp(Response, "Body") if StatusCode = 200 then Document_ := DomCreateDocument(0, "", "", 0) DomSetStringProp(Document_, "Xml", Body) XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:E/D:ET/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") if Node = 0 then XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:VBAS/D:OF/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") Name := DomGetStringProp(Node, "NodeValue") XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:VBAS/D:AD/D:UC/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") Address := DomGetStringProp(Node, "NodeValue") XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:VBAS/D:AA/D:PSC/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") PostalCode := DomGetStringProp(Node, "NodeValue") XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:VBAS/D:AA/D:N/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") City := DomGetStringProp(Node, "NodeValue") XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:VBAS/D:ICO/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") Cin := DomGetStringProp(Node, "NodeValue") XPathResult := DomEvaluate(Document_, "/are:Ares_odpovedi/are:Odpoved/D:VBAS/D:DIC/node()", 0, 0, 0, XPathResult) Node := DomGetIntegerProp(XPathResult, "SingleNodeValue") Tin := DomGetStringProp(Node, "NodeValue") S := Name + CRLF S := S + Address + CRLF S := S + PostalCode + " " + City + CRLF S := S + Cin + CRLF S := S + Tin write(S) else Error := DomGetStringProp(Node, "NodeValue") end else Error := StatusCode + CRLF + CRLF + Body end DomFree(Document_) else Error := LastErrorGetMessage() + "(" + LastErrorGetCode() + ")" end HttpFree(Request) HttpFree(Connection) result := Error = "" if not result then write(Error) result := false end endVíce informací
https://wwwinfo.mfcr.cz/ares/ares_xml.html.cz