dbxml1.~pas

用于将XML文件转化成关系数据库

unit DBXML1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  DB,DBTables,ComObj,SHDocVw, ExtCtrls,ActiveX, OleCtrls,MSXML_TLB;
type
  TDBXml=class
  private
     DBPath:string;
  public
     doc : IXMLDOMDocument;
     root,child,child1 : IXMLDomElement;
     constructor create;
     destructor Destroy;override;
     function DBtoXML(table:TTable):integer;
     procedure showXML;
     procedure WBloadHTML(WebBrowser:TWebBrowser; HTML: string);
     function showHTML(WebBrowser:TWebBrowser;flag:string):variant;
  end;

implementation

constructor TDBXml.create;
begin
     DBpath:='E:\work\XML\dbdemos.mdb';
     inherited;
end;

destructor TDBXml.Destroy;
begin

end;

function TDBXml.DBtoXML(table:TTable):integer;
var
    i : Integer;
    xml,temp : string;
begin
    try
        table.close;
        table.open;
        xml := table.TableName;
        doc := CreateOleObject('Microsoft.XMLDOM') as IXMLDomDocument;
        root := doc.createElement(xml);
        doc.appendchild(root);
        //This while loop will go through the entaire table to generate the xml file
        while not table.eof do
        begin
            //adds the first level children , Records
            child:= doc.createElement('Records');
            root.appendchild(child);
            for i:=0 to table.FieldCount-1 do
            begin
                //adds second level children
                child1:=doc.createElement(table.Fields[i].FieldName);
                child.appendchild(child1);
            //Check field types
            case TFieldType(Ord(table.Fields[i].DataType)) of
            ftString:
            begin
              if Table.Fields[i].AsString ='' then
                  temp :='null' //Put a default string
              else
                  temp := table.Fields[i].AsString;
              end;
              ftInteger, ftWord, ftSmallint:
              begin
              if Table.Fields[i].AsInteger > 0 then
                  temp := IntToStr(table.Fields[i].AsInteger)
              else
                  temp := '0';
              end;
              ftFloat, ftCurrency, ftBCD:
              begin
                  if table.Fields[i].AsFloat > 0 then
                      temp := FloatToStr(table.Fields[i].AsFloat)
                  else
                      temp := '0';
              end;
              ftBoolean:
              begin
              if table.Fields[i].Value then
                  temp:= 'True'
              else
                  temp:= 'False';
              end;
              ftDate:
              begin
              if (not table.Fields[i].IsNull) or (Length(Trim(table.Fields[i].AsString)) > 0) then
                  temp := FormatDateTime('MM/DD/YYYY',table.Fields[i].AsDateTime)
              else
                  temp:= '01/01/2000'; //put a valid default date
              end;
              ftDateTime:
              begin
                  if (not table.Fields[i].IsNull) or (Length(Trim(table.Fields[i].AsString)) > 0) then
                      temp := FormatDateTime('MM/DD/YYYY hh:nn:ss',Table.Fields[i].AsDateTime)
                  else
                      temp := '01/01/2000 00:00:00'; //Put a valid default date and time
                  end;
              ftTime:
              begin
                  if (not table.Fields[i].IsNull) or (Length(Trim(table.Fields[i].AsString)) > 0) then
                        temp := FormatDateTime('hh:nn:ss',table.Fields[i].AsDateTime)
                  else
                        temp := '00:00:00'; //Put a valid default time
                  end;
              end;
              child1.appendChild(doc.createTextNode(temp));
              end;
        table.Next;
        end;
        doc.save(xml+'.xml');
        Result:=1;
    except
        on e:Exception do
        Result:=-1;
    end;
end;

procedure TDBXML.showXML;
var
   html:string;
   fs:Tfilestream;
   ms:Tstringstream;
   fn:pchar;
   i:integer;
begin
    html:='<XML ID="dsocustomer" src="'+ExtractFilePath(Application.ExeName)+root.nodeName+'.xml"></XML>'#13#10;
    html:=html+'<h2>'+root.nodeName+'</h2>'#13#10;
    html:=html+'<table ID="table" datasrc="#dsocustomer"  datapagesize="5" border="1" width="100%" cellspacing="0" bordercolor="#008080" cellpadding="5">'#13#10;
    html:=html+'  <thead>'#13#10;
    for i:=0 to root.firstChild.childNodes.length-1 do
      html:=html+'    <th width="7%">'+root.firstChild.childNodes.item[i].nodeName+'</th>'#13#10;
    html:=html+'  </thead>'#13#10;
    html:=html+'  <tr>'#13#10;
    for i:=0 to root.firstChild.childNodes.length-1 do
      html:=html+'    <td width="7%"><span datafld="'+root.firstChild.childNodes.item[i].nodeName+'"></span></td>'#13#10;
    html:=html+'  </tr>'#13#10;
    html:=html+'  </table>'#13#10;
    html:=html+'  <p align="right">'#13#10;
    html:=html+'<input type="hidden" value="|< 第一页" name="fp" onclick="table.firstPage()"></input>'#13#10;
    html:=html+'<input type="hidden" value="< 前一页" name="pp" onclick="table.previousPage()"></input>'#13#10;
    html:=html+'<input type="hidden" value="下一页 >" name="np" onclick="table.nextPage()"></input>'#13#10;
    html:=html+'<input type="hidden" value="最后页 >|" name="lp" onclick="table.lastPage()"></input>'#13#10;
    fn:=pchar(string(root.nodeName+'.htm'));
    fs:=Tfilestream.Create(fn,fmcreate);
    ms:=TStringStream.Create('');
    try
      ms.WriteString(html);
      ms.Position:=0;
      fs.CopyFrom(ms,ms.Size);
    finally
      fs.Free;
      ms.Free;
    end;
end;

procedure TDBXml.WBloadHTML(WebBrowser:TWebBrowser; HTML: string);
var
  sl: TStringList;
  ms: TMemoryStream;
begin
    WebBrowser.Navigate('about:blank');
    while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
        Application.ProcessMessages;
        if Assigned(WebBrowser.Document) then
        begin
          sl := TStringList.Create;
          try
            ms := TMemoryStream.Create;
            try
              sl.Text := HTML;
              sl.SaveToStream(ms);
              ms.Seek(0, 0);
              (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
            finally
            ms.Free;
          end;
          finally
          sl.Free;
          end;
        end;
end;

function TDBXml.showHTML(WebBrowser:TWebBrowser;flag:string):variant;
begin
    result:=WebBrowser.oleobject.document.all.item(flag,0);
end;

end.