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
end
Více informací
https://wwwinfo.mfcr.cz/ares/ares_xml.html.cz