Сбростить 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