Delphi-Help

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; 

<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>