- Delphiartiklar, tips, forum, länksamling - 

      

START | DELPHI | LÄNKARGÄSTBOK 




 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: 1173
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;  

 
 
© Copyright 2005 - Staffan Berg
- Alla rättigheter förbehålles -