Форум: "Основная";
Текущий архив: 2005.10.09;
Скачать: [xml.tar.bz2];
ВнизИмпорт 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;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.016 c