home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / Construc / TABLEXML.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-07  |  3.5 KB  |  120 lines
  1. unit TableXML;
  2. interface
  3. uses
  4.   DB;
  5.  
  6. function DataSetXML(DataSet: TDataSet; const FileName: String): Integer;
  7.  
  8. implementation
  9. uses
  10.   SysUtils, TypInfo;
  11.  
  12. function DataSetXML(DataSet: TDataSet; const FileName: String): Integer;
  13. var
  14.   F: System.Text;
  15.   i: Integer;
  16.  
  17.   function Print(Str: String): String;
  18.   { Convert a fieldname to a printable name }
  19.   var
  20.     i: Integer;
  21.   begin
  22.     for i:=Length(Str) downto 1 do
  23.       if not (UpCase(Str[i]) in ['A'..'Z','1'..'9']) then
  24.         Str[i] := '_';
  25.     Result := Str
  26.   end {Print};
  27.  
  28.   function EnCode(Str: String): String;
  29.   { Convert memo contents to single line XML }
  30.   var
  31.     i: Integer;
  32.   begin
  33.     for i:=Length(Str) downto 1 do
  34.     begin
  35.       if (Ord(Str[i]) < 32) or (Str[i] = '"') then
  36.       begin
  37.         Insert('&#'+IntToStr(Ord(Str[i]))+';',Str,i+1);
  38.         Delete(Str,i,1)
  39.       end
  40.     end;
  41.     Result := Str
  42.   end {EnCode};
  43.  
  44. begin
  45.   Result := -1;
  46.   ShortDateFormat := 'YYYYMMDD';
  47.   System.Assign(F,FileName);
  48.   try
  49.     System.Rewrite(F);
  50.     writeln(F,'<?xml version="1.0" standalone="yes"?>');
  51.     writeln(F,'<DATAPACKET Version="2.0">');
  52.     with DataSet do
  53.     begin
  54.       writeln(F,'<METADATA>');
  55.       writeln(F,'<FIELDS>');
  56.       if not Active then
  57.         FieldDefs.Update { get info without opening the database };
  58.       for i:=0 to Pred(FieldDefs.Count) do
  59.       begin
  60.         write(F,'<FIELD ');
  61.         if Print(FieldDefs[i].Name) <> FieldDefs[i].Name then { fieldname }
  62.           write(F,'fieldname="',FieldDefs[i].Name,'" ');
  63.         write(F,'attrname="',Print(FieldDefs[i].Name),'" fieldtype="');
  64.         case FieldDefs[i].DataType of
  65.           ftString,
  66.        ftFixedChar,
  67.       ftWideString: write(F,'string');
  68.          ftBoolean: write('boolean');
  69.         ftSmallint: write(F,'i2');
  70.          ftInteger: write(F,'i4');
  71.          ftAutoInc: write(F,'i4" readonly="true" SUBTYPE="Autoinc');
  72.             ftWord, // why not i4 ??
  73.            ftFloat: write(F,'r8');
  74.         ftCurrency: write(F,'r8" SUBTYPE="Money');
  75.              ftBCD: write(F,'fixed');
  76.             ftDate: write(F,'date');
  77.             ftTime: write(F,'time');
  78.         ftDateTime: write(F,'datetime');
  79.            ftBytes: write(F,'bin.hex');
  80.         ftVarBytes,
  81.             ftBlob: write(F,'bin.hex" SUBTYPE="Binary');
  82.             ftMemo: write(F,'bin.hex" SUBTYPE="Text');
  83.          ftGraphic,
  84.      ftTypedBinary: write(F,'bin.hex" SUBTYPE="Graphics');
  85.          ftFmtMemo: write(F,'bin.hex" SUBTYPE="Formatted');
  86.       ftParadoxOle,
  87.         ftDBaseOle: write(F,'bin.hex" SUBTYPE="Ole')
  88.         end;
  89.         if FieldDefs[i].Required then write(F,'" required="true');
  90.         if FieldDefs[i].Size > 0 then write(F,'" WIDTH="',FieldDefs[i].Size);
  91.         writeln(F,'"/>')
  92.       end;
  93.       writeln(F,'</FIELDS>');
  94.       writeln(F,'</METADATA>');
  95.       if not Active then Open;
  96.       writeln(F,'<ROWDATA>');
  97.       Result := 0;
  98.       while not Eof do
  99.       begin
  100.         Result := Result + 1;
  101.         write(F,'<ROW ');
  102.         for i:=0 to Pred(Fields.Count) do
  103.           if (Fields[i].AsString <> '') and
  104.             ((Fields[i].DisplayText = Fields[i].AsString) or
  105.              (Fields[i].DisplayText = '(MEMO)')) then
  106.             write(F,Print(Fields[i].FieldName),'="',
  107.                     EnCode(Fields[i].AsString),'" ');
  108.         writeln(F,'/>');
  109.         Next
  110.       end;
  111.       writeln(F,'</ROWDATA>')
  112.     end;
  113.     writeln(F,'</DATAPACKET>')
  114.   finally
  115.     System.Close(F)
  116.   end
  117. end;
  118.  
  119. end.
  120.