Сбростить BDE базу данных в XML файл
Материал из DRKB
Сбросить BDE базу данных в XML файл[править | править код]
procedure CreateXML(Alias: string; XMLName: string);
var
i, j, x, y: Integer;
f: TextFile;
Tables: TStringList;
Table: TTable;
function FixValue(Value: string): string;
var
n: Integer;
begin
Result := '';
for n := 1 to Length(Value) do
if Value[n] in ['0'..'9','a'..'z','A'..'Z','.',',','-',' ','/','*',':','{','}','_','@','\','+','%'] then
Result := Result + Value[n]
else
Result := Result + '&#' + IntToStr(Ord(Value[n])) + ';';
end;
procedure WriteValue(Indent: Integer; Name, ParamName, ParamValue, Value: string);
var
temp: string;
const
Empty = ' ';
begin
temp := Copy(Empty, 1, Indent);
temp := temp + '<' + Name;
if ParamName = '' then
temp := temp + '>'
else
temp := temp + ' ' + Paramname + '="' + FixValue(ParamValue) + '">';
Temp := Temp + FixValue(Value) + '</' + Name + '>';
WriteLn(f, temp);
end;
procedure WriteTag(Indent: Integer; Name, ParamName, ParamValue: string; Open: Boolean = True);
var
temp: string;
const Empty = ' ';
begin
Temp := Copy(Empty, 1, Indent);
if Open then
temp := temp + '<' + Name
else
temp := temp + '</' + Name;
if ParamName = '' then
temp := temp + '>'
else
temp := temp + ' ' + Paramname + '="' + FixValue(ParamValue) + '">';
Writeln(f, temp);
end;
begin
Tables := TStringList.Create;
Table := TTable.Create(nil);
try
session.GetTableNames(Alias, '*.db', False, False, Tables);
Table.DatabaseName := Alias;
AssignFile(f,XMLName);
Rewrite(f);
WriteTag(0, Alias, '', '', True);
for i := 0 to Tables.Count-1 do
begin
Table.Active := False;
Table.TableName := Tables[i];
WriteTag(1, Table.tablename, '', '', True);
Table.Active := True;
Table.First;
for j := 0 to Table.RecordCount-1 do
begin
WriteTag(2, 'Rec', '', '', True);
for x := 0 to Table.fields.count-1 do
WriteValue(4, Table.Fields[x].FieldName, '', '', Table.Fields[x].AsString);
WriteTag(2, 'Rec', '', '', False);
Table.Next;
end;
WriteTag(1, Table.TableName, '', '', False);
end;
WriteTag(0, Alias, '', '', False);
CloseFile(f);
finally
Tables.Free;
Table.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateXML('MyDatabase', 'c:\XMLFile.xml');
end;
XML формируется в виде
<MyDatabase>
<Table1>
<Rec>
<Field1>Value1</Field1>
<Field2>Value2</Field2>
<Field3>Value3</Field3>
</Rec>
<Rec>
<Field1>Value1</Field1>
<Field2>Value2</Field2>
<Field3>Value3</Field3>
</Rec>
</Table1>
<Table2>
<Rec>
<Field1>Value1</Field1>
<Field2>Value2</Field2>
<Field3>Value3</Field3>
</Rec>
<Rec>
<Field1>Value1</Field1>
<Field2>Value2</Field2>
<Field3>Value3</Field3>
</Rec>
</Table2>
</MyDatabase>
Author: Vit
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03109