Dataset - exportando para xml

Top  Previous  Next

{Unit to export a dataset to XML} 

 

unit DS2XML; 

 

interface 

 

uses 

  Classes, DB; 

 

procedure DatasetToXML(Dataset: TDataSet; FileName: string); 

 

implementation 

 

uses 

  SysUtils; 

 

var 

  SourceBuffer: PChar; 

 

procedure WriteString(Stream: TFileStream; s: string); 

begin 

  StrPCopy(SourceBuffer, s); 

  Stream.Write(SourceBuffer[0], StrLen(SourceBuffer)); 

end

 

procedure WriteFileBegin(Stream: TFileStream; Dataset: TDataSet); 

 

  function XMLFieldType(fld: TField): string; 

  begin 

    case fld.DataType of 

      ftString: Result   := '"string" WIDTH="' + IntToStr(fld.Size) + '"'

      ftSmallint: Result := '"i4"'//?? 

      ftInteger: Result  := '"i4"'

      ftWord: Result     := '"i4"'//?? 

      ftBoolean: Result  := '"boolean"'

      ftAutoInc: Result  := '"i4" SUBTYPE="Autoinc"'

      ftFloat: Result    := '"r8"'

      ftCurrency: Result := '"r8" SUBTYPE="Money"'

      ftBCD: Result      := '"r8"'//?? 

      ftDate: Result     := '"date"'

      ftTime: Result     := '"time"'//?? 

      ftDateTime: Result := '"datetime"'

      else 

    end

    if fld.Required then 

      Result := Result + ' required="true"'

    if fld.ReadOnly then 

      Result := Result + ' readonly="true"'

  end

var 

  i: Integer; 

begin 

  WriteString(Stream, '<?xml version="1.0" standalone="yes"?><!-- Generated by SMExport -->  ' + 

    '<DATAPACKET Version="2.0">'); 

  WriteString(Stream, '<METADATA><FIELDS>'); 

 

  {write th metadata} 

  with Dataset do 

    for i := 0 to FieldCount - 1 do 

    begin 

      WriteString(Stream, '<FIELD attrname="' + 

        Fields[i].FieldName + 

        '" fieldtype=' + 

        XMLFieldType(Fields[i]) + 

        '/>'); 

    end

  WriteString(Stream, '</FIELDS>'); 

  WriteString(Stream, '<PARAMS DEFAULT_ORDER="1" PRIMARY_KEY="1" LCID="1033"/>'); 

  WriteString(Stream, '</METADATA><ROWDATA>'); 

end

 

procedure WriteFileEnd(Stream: TFileStream); 

begin 

  WriteString(Stream, '</ROWDATA></DATAPACKET>'); 

end

 

procedure WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean); 

begin 

  if not IsAddedTitle then 

    WriteString(Stream, '<ROW'); 

end

 

procedure WriteRowEnd(Stream: TFileStream; IsAddedTitle: Boolean); 

begin 

  if not IsAddedTitle then 

    WriteString(Stream, '/>'); 

end

 

procedure WriteData(Stream: TFileStream; fld: TField; AString: ShortString); 

begin 

  if Assigned(fld) and (AString <> '') then 

    WriteString(Stream, ' ' + fld.FieldName + '="' + AString + '"'); 

end

 

function GetFieldStr(Field: TField): string; 

 

  function GetDig(i, j: Word): string; 

  begin 

    Result := IntToStr(i); 

    while (Length(Result) < j) do 

      Result := '0' + Result; 

  end

var  

  Hour, Min, Sec, MSec: Word; 

begin 

  case Field.DataType of 

    ftBoolean: Result := UpperCase(Field.AsString); 

    ftDate: Result    := FormatDateTime('yyyymmdd', Field.AsDateTime); 

    ftTime: Result    := FormatDateTime('hhnnss', Field.AsDateTime); 

    ftDateTime:  

      begin 

        Result := FormatDateTime('yyyymmdd', Field.AsDateTime); 

        DecodeTime(Field.AsDateTime, Hour, Min, Sec, MSec); 

        if (Hour <> 0or (Min <> 0or (Sec <> 0or (MSec <> 0) then 

          Result := Result + 'T' + GetDig(Hour, 2) + ':' + GetDig(Min, 

            2) + ':' + GetDig(Sec, 2) + GetDig(MSec, 3); 

      end

    else 

      Result := Field.AsString; 

  end

end

 

procedure DatasetToXML(Dataset: TDataSet; FileName: string); 

var 

  Stream: TFileStream; 

  bkmark: TBookmark; 

  i: Integer; 

begin 

  Stream       := TFileStream.Create(FileName, fmCreate); 

  SourceBuffer := StrAlloc(1024); 

  WriteFileBegin(Stream, Dataset); 

 

  with DataSet do 

  begin 

    DisableControls; 

    bkmark := GetBookmark; 

    First; 

 

    {write a title row} 

    WriteRowStart(Stream, True); 

    for i := 0 to FieldCount - 1 do 

      WriteData(Stream, nil, Fields[i].DisplayLabel); 

    {write the end of row} 

    WriteRowEnd(Stream, True); 

 

    while (not EOF) do 

    begin 

      WriteRowStart(Stream, False); 

      for i := 0 to FieldCount - 1 do 

        WriteData(Stream, Fields[i], GetFieldStr(Fields[i])); 

      {write the end of row} 

      WriteRowEnd(Stream, False); 

 

      Next; 

    end

 

    GotoBookmark(bkmark); 

    EnableControls; 

  end

 

  WriteFileEnd(Stream); 

  Stream.Free; 

  StrDispose(SourceBuffer); 

end

 

end

 

 

//Beispiel, Example: 

 

 

uses DS2XML; 

 

procedure TForm1.Button1Click(Sender: TObject); 

  begin  DatasetToXML(Table1, 'test.xml'); 

  end