delphi 学习 xml文件读取

这是一个xml转成access数据的demo

有些还没整理完。希望高手改善！

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ExtCtrls, StdCtrls, Grids, Menus, Db, ADODB;

type
TForm1 = class(TForm)
Panel1: TPanel;
MainMenu1: TMainMenu;
open_N1: TMenuItem;
daoru_N2: TMenuItem;
select_N3: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Edit1: TEdit;
Edit2: TEdit;
Memo1: TMemo;
ADO: TADOConnection;
ADOQuery1: TADOQuery;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
procedure daoru_N2Click(Sender: TObject);
private

{ Private declarations }
public
procedure WriteRecordfields(nodesname,nodesvalue:string ;const n:integer); //形成sql插入语句
procedure create_table(nodesname:string;const n:integer);
function GetTempPathFileName: string;
procedure lvadd(const path1:string);
procedure readxml(const filename:string);
function create_mdb(const fnames:string):boolean;
function CompactDatabase(AFileName:string):boolean;
procedure conning_mdb(sql:string);
procedure bianli_create(const filename:string);
{ Public declarations }
end;

var
Form1: TForm1;
path:string;
fname:string;
strtxt :Tstringlist;
implementation
uses nativexml,Comobj, SYSTEMD7;

{$R *.DFM}

procedure TForm1.lvadd(const path1: string);// 获取XML目录
var
// i:integer;
Sr:TsearchRec;
// findNode:TTreeNode;
// name:Array
of string;

begin
Path:=path1;
//stringgrid1.rowcount:=0;
if Path[length(path)]<>'/'then
path:=path+'/*.*'
else
path:=path+'*.*';
//with stringgrid1 do
// begin
if findfirst(path,faanyfile,sr)=0 then
begin
repeat
if (sr.Attr and fadirectory) =sr.Attr then
if (sr.name='.') or (sr.name='..') then
begin
continue;
end
else
begin
path:=path1+sr.Name;
readxml(path);
end;
path:=path1+sr.Name;
readxml(path);
until findnext(sr)<>0;
findclose(sr);
end;
//end;
end;
procedure TForm1.readxml(const filename: string); //遍历读取节点值
var
ADoc : TNativeXml;
LRootNode : TXmlNode;

procedure ProcessNode(ANode: TXmlNode);
begin
Memo1.Lines.Add(Format('%s=%s', [ANode.Name, ANode.ValueAsString]));
end;
procedure processNode_c(ANode:Txmlnode);
begin
memo1.lines.add(anode.name);
end;

function LoadXML(const AFileName: string): TNativeXml;
var
AXML : TStrings;
begin
Result := TNativeXml.Create;
AXML := TStringList.Create;
try
AXML.LoadFromFile(AFileName);
Result.ReadFromString(sdUtf8ToAnsi(AXML.Text));
finally
AXML.Free;
end;
end;

procedure ReadRecordFields(ARecordNode: TXmlNode);
var
i : Integer;
begin
if Assigned(ARecordNode) then
begin
strtxt:=Tstringlist.Create ;
for i := 0 to ARecordNode.NodeCount - 1 do
begin
strtxt.Add(ARecordNode.Nodes[i].Name);
ProcessNode(ARecordNode.Nodes[i]);
end;
create_table(arecordnode.name,1);
strtxt.Free;
end;
end;

procedure ReadRecordSubRecords(ASubRecordsNode: TXmlNode);

procedure ReadSubRecordFields(AFieldsNode: TXmlNode);
var
i : Integer;
begin
for i := 0 to AFieldsNode.NodeCount - 1 do
begin
ProcessNode(AFieldsNode.Nodes[i]);
end;
end;

procedure ReadSubRecordFiles(AFilesNode: TXmlNode);

procedure ReadFileNode(AFileNode: TXmlNode);
var
i : Integer;
begin
if not Assigned(AFileNode) then Exit;

for i := 0 to AFileNode.NodeCount - 1 do
begin
ProcessNode(AFileNode.Nodes[i]);
end;
end;

var
i : Integer;
begin
if not Assigned(AFilesNode) then Exit;
//ProcessNode(AFilesNode);
for i :=0 to AFilesNode.NodeCount - 1 do
begin
ReadFileNode(AFilesNode.Nodes[i]);
end;
end;

var
i : Integer;
begin
if not Assigned(ASubRecordsNode) then Exit;
//ProcessNode(ASubRecordsNode);
for i := 0 to ASubRecordsNode.NodeCount - 1 do
begin
ReadSubRecordFields(ASubRecordsNode.Nodes[i].FindNode('/archives/records/record/sub-records/sub-record/fields'));
ReadSubRecordFiles(ASubRecordsNode.Nodes[i].FindNode('/archives/records/record/sub-records/sub-record/files'));
end;
end;

begin
Memo1.Lines.Clear;
ADoc := LoadXML(filename);
try
LRootNode := ADoc.Root;
if Assigned(LRootNode) then
begin
ReadRecordFields(LRootNode.FindNode('/archives/records/record/fields'));
ReadRecordSubRecords(LRootNode.FindNode('/archives/records/record/sub-records'));
end;
finally
ADoc.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// lvadd('F:/开发银行数据库资料/metadata');
// readxml('F:/开发银行数据库资料/metadata/B01_3510-2000-003-1-1.xml');
//create_table('ssfd',3);
end;

procedure TForm1.daoru_N2Click(Sender: TObject);
var
filename:string;
PATH:STRING;
begin

savedialog1.Filter :='Access Files (*.mdb)|*.mdb';

if savedialog1.Execute then
begin

path:=ExtractFilePath(SaveDialog1.FileName);

Fname:=SaveDialog1.FileName;
filename:=extractfilename(savedialog1.filename);

if create_mdb(fname)=true then
begin
application.MessageBox('该文件成功！','提示',mb_ok + mb_iconinformation);
if fileExists(filename)=true then //判断文件存在连接数据库建表
begin
opendialog1.Filter :='XML Files (*.XML)|*.XML';
if opendialog1.Execute then
begin
path:=ExtractFilePath(opendialog1.FileName);
MEMO2.Lines.ADD(PATH);
lvadd(path);
end;
end
else
application.MessageBox('文件不存在！','提示',mb_ok + mb_iconinformation);
end
else if application.MessageBox('该文件存在！是否覆盖源文件！','提示',MB_YESNO + mb_iconinformation)=idyes then
begin
if CompactDatabase(fname)=true then
application.MessageBox('覆盖成功！','提示',mb_ok + mb_iconinformation)
else
application.MessageBox('覆盖失败！','提示',mb_ok + mb_iconinformation);
end;

end;
end;
function TForm1.GetTempPathFileName():string;//取得临时文件名
var
SPath,SFile:array [0..254] of char;
begin
GetTempPath(254,sPath);
GetTempFileName(sPath,'~SM',0,SFile);
result:=SFile;
DeleteFile(PChar(result));

end;
function TForm1.create_mdb(const fnames:string):boolean; //创建access数据库,如果存在这创建失败
var
yuanname:string;
CreateAccess:OleVariant;
begin
yuanname:=GetTempPathFileName;
try
CreateAccess:=CreateOleObject('ADOX.Catalog');
CreateAccess.Create(format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s',[yuanname]));
result:=copyfile(pchar(yuanname),Pchar(Fnames),true);
DeleteFile(yuanname);
except
result:=false;
end;
end;
function TForm1.CompactDatabase(AFileName:string):boolean; //压缩与修复数据库,覆盖源文件
var
STempFileName:string;
vJE:OleVariant;
begin
STempFileName:=GetTempPathFileName;
try
vJE:=CreateOleObject('JRO.JetEngine');
vJE.CompactDatabase(format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s',[AFileName]),
format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s',[STempFileName]));
result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
DeleteFile(STempFileName);
except
result:=false;
end;
end;
procedure TForm1.conning_mdb(sql:string); //数据库连接
var
strcon,str_sql:string;
begin
strcon:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+fname;
ADO.ConnectionString:=strcon;
if not ADO.connected then
begin
ADO.connected:=true;
end;
adoquery1.connection:=ADO;
adoquery1.close;
adoquery1.SQL.Clear;
str_sql := sql;
adoquery1.sql.add(str_sql);
adoquery1.ExecSQL;
ado.Close;
end;

procedure TForm1.WriteRecordfields(nodesname, nodesvalue: string;const n:integer); //形成sql插入语句
var
i :integer;
str,strvalues :string;
sqlstr:string;
begin
for i:=0 to strtxt.Count -1 do
begin
if i>0 then
begin
str:=str+',';
strvalues:=strvalues+',';
end;
str:=str+strtxt.Names[i];
if strtxt.Values[strtxt.Names[i]]='' then
begin
strvalues:=strvalues+'"'+'null'+'"';
end else
begin
strvalues:= strvalues+ '"'+strtxt.Values[strtxt.Names[i]]+'"';
end;

end;
sqlstr:='insetr into ('+str+') values ('+strvalues+')' ;
if n=1 then
sqlstr:='insetr into Files_tbl ('+str+') values ('+strvalues+')'
else if n=2 then
sqlstr:= 'insetr into Arkkchives_tbl ('+str+') values ('+strvalues+')'
else if n=3 then
sqlstr:= 'insetr into Files_path ('+str+') values ('+strvalues+')' ;
conning_mdb(sqlstr);
memo2.Lines.Add(sqlstr);

end;

procedure TForm1.create_table(nodesname: string; const n: integer); //形成表的创建语句
var
i :integer;
str :string;
sqlstr:string;
begin
for i:=0 to strtxt.Count - 1 do
begin
if i>0 then str:=str+',';
str:=str+strtxt.Strings[i]+' varchar(255)';
end;
if n=1 then
sqlstr:='create table Arkkchives_tbl ('+'ID counter primary key'+','+str+')'
else if n=2 then
sqlstr:='create table Files_tbl ('+'ID counter primary key'+','+str+')'
else if n=3 then
sqlstr:='create table Files_path ('+'ID counter primary key'+','+str+')';
memo2.Lines.Add(sqlstr);
conning_mdb(sqlstr);

end;

procedure TForm1.bianli_create(const filename: string); //遍历表结构
var
ADoc : TNativeXml;
LRootNode : TXmlNode;
procedure processNode_c(ANode:Txmlnode);
begin
memo1.lines.add(anode.name);
end;
function LoadXML(const AFileName: string): TNativeXml;
var
AXML : TStrings;
begin
Result := TNativeXml.Create;
AXML := TStringList.Create;
try
AXML.LoadFromFile(AFileName);
Result.ReadFromString(sdUtf8ToAnsi(AXML.Text));
finally
AXML.Free;
end;
end;
procedure ReadRecordFields(ARecordNode: TXmlNode);
var
i : Integer;
begin
if Assigned(ARecordNode) then
begin
for i := 0 to ARecordNode.NodeCount - 1 do
begin
ProcessNode_c(ARecordNode.Nodes[i]);
end;
end;
end;
procedure ReadRecoredSubrecords(ARecordNode:TxmlNode);
var
i :integer;
begin
if Assigned(ARecordNode) then
begin
for i:=0 to ARecordNode.NodeCount - 1 do
begin
ProcessNode_c(ARecordNode.Nodes[i]);
end;
end;
end;
procedure ReadSubRecordFiles(AFilesNode: TXmlNode);
var
i : Integer;
begin
if not Assigned(AFilesNode) then Exit;

//ProcessNode(AFilesNode);
for i :=0 to AFilesNode.NodeCount - 1 do
begin
ProcessNode_c(AfilesNode.Nodes[i]);
end;
end;

begin
Memo1.Lines.Clear;
ADoc := LoadXML(Edit1.Text);
try
LRootNode := ADoc.Root;
if Assigned(LRootNode) then
begin
ReadRecordFields(LRootNode.FindNode('/archives/records/record/fields'));
ReadRecoredSubrecords(LRootNode.FindNode('/archives/records/record/sub-records/sub-record/fields'));

ReadSubRecordFiles(LRootNode.FindNode('/archives/records/record/sub-records/sub-record/files/file'));
end;
finally
ADoc.Free;
end;
end;

end.