' ------------------------------------------------------------ ' Xara3D-renderurl2.vbs ' Script calling the "Xara 3D Graphics Generator" WebService ' to generate 3d captions. ' The script retrives from the service the list of avalaible ' templates and the list of avalaible fonts. It will generate ' a picture for each template-font couple (that might take ' a while on a slow Internet connection). ' Code based on "renderurl.js" from xara (www.xara.com). ' SOAP toolkit runtime needed. ' ------------------------------------------------------------ Option Explicit Dim Result, sOutFile, alb, tabTemplates, sTemplate, k, sFile, tabFonts, sFont App.ClearTrace const WRAPPER_ELEMENT_NAMESPACE = "http://soap.xara.com/message/" const END_POINT_URL = "http://ws.xara.com/graphicrender/render3d.asp" sOutFile = "d:\temp\testXara" ' Base name of the generated pictures set alb = App.GetCurrentAlbum sFont = "DicotMedium Regular" k = 1 app.Trace "Retrieving the template list..." tabTemplates = getList( "Template", "GetTemplates" ) app.Trace "Retrieving the font list..." tabFonts = getList( "Font", "GetFonts" ) GeneratePictures app.Trace "Done !" ' ------------------------------------------------------------ function GeneratePictures for each sTemplate in tabTemplates for each sFont in tabFonts app.Trace "Generating picture for template: " & sTemplate & " and font: " & sFont Result = RenderURL( sTemplate, "MyAlbum", "660099", "FFFFFF", sFont, "200", "jpg", 0, 0 ) sFile = sOutFile & "_" & sTemplate & "_" & sFont & ".jpg" SavePicture Result, sFile next next end function ' ------------------------------------------------------------ function SavePicture( URL, sFileName ) if left(URL,7) = "http://" then App.Trace " Generated graphic: " & URL 'App.Run( URL, true, 1 ); App.Trace " Retrieving picture..." if App.HTTPGet( Result, sFileName ) = 0 then App.Trace " Adding picture " & sFileName alb.AddPicture sFileName alb.Redraw end if else App.Trace "Error with web service..." end if end function ' ------------------------------------------------------------ function RenderURL(templ, text, textcol, bgcol, font, fsize, exptype, width, height) Dim EndPointURL, Method, Serializer, Reader, Connector EndPointURL = END_POINT_URL Method = "RenderURL" App.Trace " Connecting: " & END_POINT_URL set Connector = CreateObject("MSSOAP.HttpConnector") Connector.Property("EndPointURL") = EndPointURL Connector.BeginMessage set Serializer = CreateObject("MSSOAP.SoapSerializer") Serializer.Init Connector.InputStream Serializer.startEnvelope Serializer.startBody Serializer.startElement Method, WRAPPER_ELEMENT_NAMESPACE, "", "m" Serializer.startElement "Template" Serializer.writeString templ Serializer.endElement Serializer.startElement "Text" Serializer.writeString text Serializer.endElement Serializer.startElement "TextColor" Serializer.writeString textcol Serializer.endElement Serializer.startElement "BGColor" Serializer.writeString bgcol Serializer.endElement Serializer.startElement "Font" Serializer.writeString font Serializer.endElement Serializer.startElement "FontSize" Serializer.writeString fsize Serializer.endElement Serializer.startElement "ExportType" Serializer.writeString exptype Serializer.endElement Serializer.endElement Serializer.endBody Serializer.endEnvelope Connector.EndMessage set Reader = CreateObject("MSSOAP.SoapReader") Reader.Load Connector.OutputStream if not isnull(Reader.Fault) then 'dim node 'set node = Reader.RPCResult 'while (not isnull(node)) ' App.Trace " " + node.nodeName + "=" + node.text ' set node = node.nextSibling 'wend RenderURL = Reader.RPCResult.text else RenderURL = "Error: " & Reader.faultstring.text end if end function function getList( ItemName, Method ) Dim EndPointURL, Serializer, Reader, Connector EndPointURL = END_POINT_URL 'Method = "GetTemplates" App.Trace " Connecting: " & END_POINT_URL set Connector = CreateObject("MSSOAP.HttpConnector") Connector.Property("EndPointURL") = EndPointURL Connector.BeginMessage set Serializer = CreateObject("MSSOAP.SoapSerializer") Serializer.Init(Connector.InputStream) Serializer.startEnvelope Serializer.startBody Serializer.startElement Method, WRAPPER_ELEMENT_NAMESPACE, "", "m" Serializer.endElement Serializer.endBody Serializer.endEnvelope Connector.EndMessage set Reader = CreateObject("MSSOAP.SoapReader") Reader.Load Connector.OutputStream if not isnull(Reader.Fault) then 'App.Trace Reader.Body.xml dim entry, i, child, child2, tabItems() i = 0 set entry = Reader.BodyEntries.item(0) set child = entry.childNodes.item(0) 'app.Trace child.xml redim tabItems( child.childNodes.length ) for each child2 in child.childNodes app.Trace " " & ItemName & " = " & child2.text tabItems(i) = child2.text i = i+1 next getList = tabItems else getList = " Error: " & Reader.faultstring.text end if end function