StarLingPlugins: plugin_xml_export.prg

File plugin_xml_export.prg, 1.8 KB (added by phil, 5 years ago)

XML export - source code

Line 
1/* $Id$ */
2
3#include "dialog.ch"
4#include "starstru.ch"
5
6INIT FUNCTION register()
7  stPluginRegister( "Export to XML", {|| export_to_xml() } )
8RETURN 0
9
10PROCEDURE export_to_xml(to_file)
11  LOCAL dlg, h, eol := hb_osNewLine(), desc, i, struct := stDbStruct(), s
12
13  IF Empty(to_file)
14    dlg := { ;
15      { st_FILENAME, "Output file (with extension)" } }
16    IF !stDialog("Plugin: Export to XML", , dlg)
17      RETURN
18    ENDIF
19    to_file = dlg[1]
20  ENDIF
21  IF (h := FCreate(to_file)) == 0
22    stMessage("Couldn't create output file")
23    RETURN
24  ENDIF
25  FWrite(h, '<?xml version="1.0" encoding="UTF-8"?>' + eol)
26  FWrite(h, '<root>' + eol)
27  desc := infRead(stDbfNameExt(), "DBINFO")
28  FWrite(h, '  <description>' + UTF8(desc) + eol + '  </description>' + eol)
29  FWrite(h, '  <fields>' + eol)
30  FOR i := 1 TO FCount()
31    FWrite(h, '    <field name="' + struct[i][DBS_NAME] + '">' + eol)
32    FWrite(h, '      <type>' + If(struct[i][DBS_TYPE] == 'N', "numeric", "character") + '</type>' + eol)
33    IF !Empty(s := AllTrim(struct[i][STAR_DBS_ALIAS]))
34      FWrite(h, '      <description>' + xml_escape(AllTrim(UTF8(s))) + '</description>' + eol)
35    ENDIF
36    FWrite(h, '    </field>' + eol)
37  NEXT
38  FWrite(h, '  </fields>' + eol)
39  FWrite(h, '  <data>' + eol)
40  GO TOP
41  DO WHILE !Eof()
42    FWrite(h, '    <record id="' + LTrim(Str(RecNo())) + '">' + eol)
43    FOR i := 1 TO FCount()
44      IF !(struct[i][DBS_TYPE] $ 'CMV' .AND. Empty(FieldGet(i)))
45        FWrite(h, '      <field name="' + struct[i][DBS_NAME] + '">' + xml_escape(UTF8(AllTrim(toString(FieldGet(i))))) + '</field>' + eol)
46      ENDIF
47    NEXT
48    FWrite(h, '    </record>' + eol)
49    SKIP
50  ENDDO
51  FWrite(h, '  </data>' + eol)
52  FWrite(h, '</root>' + eol)
53  FClose(h)
54  stOpenFile(to_file)
55RETURN
56
57STATIC FUNCTION xml_escape(s)
58RETURN StrTran(StrTran(StrTran(s, '&', '&' + 'amp;'), '<', '&' + 'lt;'), '>', '&' + 'gt;')