Текущий архив: 2005.10.09;
Скачать: CL | DM;

Вниз

Импорт xml файла   Найти похожие ветки 

← →
ktt   (2005-09-21 17:12) [0]

Этой функцией я делаю экспорт таблицы в xml, нету ли у вас
функции для приема сформированного файла ? Чтобы отобразить в dbGrid. Заранее благодарю.  

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.

//Beispiel, Example:

uses DS2XML;

procedure TForm1.Button1Click(Sender: TObject);
begin
 DatasetToXML(Table1, "test.xml");
end;

---

← →
umbra ©   (2005-09-21 17:59) [1]

А почему бы для облегчения этого ужаса (в смысле парсения xml-файла) не пользоваться компонентом TXMLdoc с вкладки Internet? Если структура таблиц фиксирована, то можно еще больше облегчить себе жизнь: с помощью мастера Xml Data Binding (File\New\Other\XML data binding wizard) можно сгенерировать интерфейс для xml конкретной структуры. Подробности - в хелпе

---

Страницы: 1 вся ветка

Текущий архив: 2005.10.09;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.025 c