Сбростить BDE базу данных в XML файл

Previous  Top  Next

    
 

 

 

Code:

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>

 

 

 

©Drkb::03109

Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)

 

Взято с Vingrad.ru http://forum.vingrad.ru