Конвертировать таблицу в XML |
Previous Top Next |
Code: |
{ SMExport suite's free demo Data export from dataset into XML-file
Copyright(C) 2000, written by Scalabium, Shkolnik Mike E-Mail: smexport@scalabium.com mshkolnik@yahoo.com WEB: http://www.scalabium.com http://www.geocities.com/mshkolnik } 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 <> 0) or (Min <> 0) or (Sec <> 0) or (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. |
©Drkb::03104
Взято с Delphi Knowledge Base: http://www.baltsoft.com/