|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Exportera ett TDataset till en XML-fil
|
Kategori: Databaser
Inlagt: 2004-01-13
Läst: 1391
Inlagt av: Staffan Berg
|
|
Beskrivning |
|
Detta är ett exempel som exporterar ett TDataset till en XML-fil
|
|
Kod |
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, ' ' +
'');
WriteString(Stream, '');
//write th metadata
with Dataset do
for i := 0 to FieldCount - 1 do
begin
WriteString(Stream, '');
end;
WriteString(Stream, '');
WriteString(Stream, '');
WriteString(Stream, '');
end;
procedure WriteFileEnd(Stream: TFileStream);
begin
WriteString(Stream, '');
end;
procedure WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean);
begin
if not IsAddedTitle then
WriteString(Stream, '
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.
//Exempel
uses DS2XML;
procedure TForm1.Button1Click(Sender: TObject);
begin DatasetToXML(Table1, 'test.xml');
end;
|
|
|