XML to SQL2000 -> Форум на Исходниках.RU [Powered by Invision Power Board]

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, XMLDoc, XMLIntf, StdCtrls, XMLdom,

TypInfo;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

dlgOpen: TOpenDialog;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

type

TCsvRow = record

AFieldName, ACell: string;

end;

TObjInfo = array of TCsvRow;

const

cnstFileName = 'C:\test.xml';

cnstFieldDelim = '.'; // разделитель xml-полей

var

Form1: TForm1;

CsvTable: array of array of string; // таблица-массив [строка][столбец]

ObjInfo: TObjInfo; // информация о текущем объекте (все поля с текущими значениями). При переходе на след.объект все потомки очищаются для заполнения новыми данными

TmpFieldIndex: integer; // текущее поле в табл.CsvTable для заполнения

TmpRecordIndex: integer; // текущая строка в табл.CsvTable для заполнения

implementation

{$R *.dfm}

function FieldIndex(AName: string): integer; // ищем поле в таблице-массиве

var

n: integer;

begin

Result := -1;

for n := 0 to high(CsvTable[0]) do

if CsvTable[0][n] = AName then

begin

Result := n;

exit;

end;

procedure AddField(AName: string); // добавляем новое поле (если нужно) в таблицу-массив и запоминаем индекс

var

m: integer;

begin

TmpFieldIndex := FieldIndex(AName);

if TmpFieldIndex < 0 then // добавляем НОВОЕ поле

begin

for m := 0 to high(CsvTable) do // бежим по строкам и в каждую добавляем новое поле

SetLength(CsvTable[m], length(CsvTable[m]) + 1);

// записываем поле в конец

TmpFieldIndex := high(CsvTable[0]);

CsvTable[0][TmpFieldIndex] := AName;

end;

procedure SaveCsv(AFileName: string); // сохраняем таблицу-массив в csv-файл

var

n, m, i: integer;

f: TextFile;

TmpStr: string;

begin

try

AssignFile(f, AFileName);

Rewrite(f);

for n := 0 to high(CsvTable) do // читаем строки

begin

TmpStr := '';

for m := 0 to high(CsvTable[n]) do // читаем столбцы

begin

if n = 0 then // 0-я строка - названия столбцов (вырезаем имя поля из пути)

begin

i := LastDelimiter(cnstFieldDelim, cnstFieldDelim + CsvTable[n][m]); // на всякий добавляем в начало пустое поле, если строка пустая

TmpStr := TmpStr + #9 + CsvTable[n][m]; //copy(CsvTable[n][m], i, length(CsvTable[n][m]) - i + 1);

end else // значения (строка >= 1)

TmpStr := TmpStr + #9 + CsvTable[n][m];

end; // for m

WriteLn(f, TmpStr);

end; // for n

finally

CloseFile(f);

end; // try

end;

function GetPath(ANode: IDOMNode): string; // получаем путь до заданного объекта

begin

if ANode = nil then

exit;

{

if ANode.localName = '' then

Result := GetPath(ANode.ParentNode)

else Result := GetPath(ANode.ParentNode) + cnstFieldDelim + ANode.localName;

}

if ANode.localName = '' then

Result := GetPath(ANode.ParentNode)

else Result := ANode.localName + cnstFieldDelim + GetPath(ANode.ParentNode);

end;

procedure GetChildNodes(Node: IDOMNode; OffSet: String); // рекурсивно перебираем дерево объектов

procedure SetParentFields; // заполняем поля текущей строки информацией по родительским объектам

var

n, m: integer;

begin

for n := 0 to high(ObjInfo) do

begin

m := FieldIndex(ObjInfo[n].AFieldName);

if m >= 0 then

CsvTable[TmpRecordIndex][m] := ObjInfo[n].ACell;

end;

procedure AddObjInfo(AField, AValue: string); // запоминаем информацию о родителе

var

n: integer;

begin

// ищем поле и обновляем значение

for n := 0 to high(ObjInfo) do

if ObjInfo[n].AFieldName = AField then

begin

ObjInfo[n].ACell := AValue;

exit;

end;

// если поле не нашли, добавляем

SetLength(ObjInfo, length(ObjInfo) + 1);

ObjInfo[high(ObjInfo)].AFieldName := AField;

ObjInfo[high(ObjInfo)].ACell := AValue;

end;

procedure ClearObjInfo(AParentPath: string); // чистим поля внутри заданного объекта (родителя)

var

n, m: integer;

begin

for n := 0 to high(ObjInfo) do

begin

{

if copy(ObjInfo[n].AFieldName, 1, length(AParentPath) + length(cnstFieldDelim)) = AParentPath + cnstFieldDelim then

ObjInfo[n].ACell := '';

}

m := length(AParentPath) + length(cnstFieldDelim);

if copy(ObjInfo[n].AFieldName, length(ObjInfo[n].AFieldName) - m + 1, m) = cnstFieldDelim + AParentPath then

ObjInfo[n].ACell := '';

end;

var

n, m: integer;

TmpPath, TmpStr: string;

TmpNode: IDOMNode;

TmpObjInfo: TObjInfo;

TmpFlag: boolean;

begin

// если ПЕРЕД этой ветвью есть ветвь с таким же именем, добавляем для текущей ветви строку

TmpFlag := false;

TmpNode := Node.previousSibling;

while TmpNode <> nil do

begin

if TmpNode.nodeName = Node.nodeName then

begin

Inc(TmpRecordIndex);

TmpFlag := true; // запоминаем, что уже добавили строку

break;

end;

TmpNode := TmpNode.previousSibling;

end;

if not TmpFlag then // если строка еще добавлена не была, проверяем другое условие

if (TmpNode <> nil) and (TmpNode.nextSibling = nil) then // если ПОСЛЕ этой ветви на ее уровне никого нет, добавляем строку

begin

Inc(TmpRecordIndex);

end;

// добавляем новую строку в таблицу-массив, если надо

if TmpRecordIndex > high(CsvTable) then

begin

// добавляем новую строку в CsvTable

SetLength(CsvTable, TmpRecordIndex + 1);

SetLength(CsvTable[TmpRecordIndex], length(CsvTable[0])); // делаем у новой строки такое же кол-во полей, как и у 0-й строки (у заголовков)

end;

TmpPath := GetPath(Node);

ClearObjInfo(TmpPath); // зайдя в новый объект, чистим вложенные объекты

// добавляем поля

AddField(TmpPath);

CsvTable[TmpRecordIndex][TmpFieldIndex] := Node.nodeValue; // записываем значение в ячейку

//Form1.Memo1.Lines.Add(IntToStr(TmpRecordIndex) + '_val ' + OffSet + TmpPath + ': ' + Node.nodeValue);

AddObjInfo(TmpPath, Node.nodeValue); // добавляем прочитанную информацию об объекте

if Node.attributes <> nil then // если есть атрибуты, обрабатываем, как значения

for n := 0 to Node.attributes.length - 1 do

begin

AddField(Node.attributes[n].nodeName + ':' + TmpPath); // добавляем атрибут как поле (если такого поля еще нету)

CsvTable[TmpRecordIndex][TmpFieldIndex] := Node.attributes[n].nodeValue; // записываем значение в ячейку

Form1.Memo1.Lines.Add(IntToStr(TmpRecordIndex) + '_atr ' + Offset + Node.attributes[n].nodeName + ':' + TmpPath + ': ' + Node.attributes[n].nodeValue);

AddObjInfo(Node.attributes[n].nodeName + ':' + TmpPath, Node.attributes[n].nodeValue);

end;

// идем дальше по дереву

for n := 0 to Node.childNodes.length - 1 do

GetChildNodes(Node.childNodes[n], OffSet + ' ');

SetParentFields; // присваиваем прочитанные ранее св-ва объектов-родителей

end;

procedure TForm1.Button1Click(Sender: TObject);

var

xmlDocument: TXMLDocument;

mainNode: IXMLNode;

nodes: IXMLNodeList;

n: Integer;

TmpObjInfo: TObjInfo;

begin

FormCreate(Sender); // обнуляем массив CsvTable

if not dlgOpen.Execute then

exit;

Memo1.Lines.LoadFromFile(dlgOpen.FileName);

xmlDocument := TXMLDocument.Create(Owner);

//xmlDocument.LoadFromFile(dlgOpen.FileName);

xmlDocument.XML.Text := Memo1.Lines.Text;

xmlDocument.Options := xmlDocument.Options + [doAttrNull];

xmlDocument.Active := True;

n := 0;

Memo1.Lines.BeginUpdate;

SetLength(ObjInfo, 0);

GetChildNodes(xmlDocument.DocumentElement.DOMNode, '');

Memo1.Lines.EndUpdate;

SaveCsv(dlgOpen.FileName + '.txt');

xmlDocument.Active := False;

xmlDocument.Free;

Memo1.Lines.Add('Готово');

Memo1.Lines.Add(#13#10#13#10#13#10#13#10#13#10);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

n: integer;

begin

dlgOpen.FileName := cnstFileName;

// чистим массив

Finalize(CsvTable);

Finalize(ObjInfo);

SetLength(CsvTable, 1); // добавляем первую строку (назв.столбцов)

TmpFieldIndex := -1; // текущее поле в табл.CsvTable для заполнения

TmpRecordIndex := 1; // текущая строка в табл.CsvTable для заполнения

end;

end.