发信人: showskyws(示天) 
整理人: teleme(2001-04-25 01:03:13), 站内信件
 | 
 
 
在delphi中使用xml文档有两种方法。 
 使用xml broker, 是delphi 内置的。例: 
 unit ShowXML; 
 
 interface 
 
 uses Classes, HTTPApp, Db, DbClient, Midas, 
   XMLBrokr, WebComp, MidItems; 
 
 type 
   TCustomShowXMLButton = class(TXMLButton, IScriptComponent) 
   protected 
     XMLMethodName: string; 
     { IScriptComponent } 
     procedure AddElements(AddIntf: IAddScriptElements); 
     function GetSubComponents: TObject; 
     { IWebContent implementation } 
     function ImplContent(Options: TWebContentOptions; 
       ParentLayout: TLayout): string; override; 
   end; 
 
   TShowXMLButton = class(TCustomShowXMLButton) 
   public 
     constructor Create(AOwner: TComponent); override; 
   published 
     property Custom; 
     property Style; 
     property StyleRule; 
     property Caption; 
     property XMLBroker; 
     property XMLUseParent; 
   end; 
 
   TShowDeltaButton = class(TCustomShowXMLButton) 
   public 
     constructor Create(AOwner: TComponent); override; 
   published 
     property Custom; 
     property Style; 
     property StyleRule; 
     property Caption; 
     property XMLBroker; 
     property XMLUseParent; 
   end; 
 
 implementation 
 
 uses sysutils, MidProd; 
 
 resourcestring  
   sShowXML = 'Show XML'; 
   sShowDelta = 'Show Delta'; 
 
 procedure TCustomShowXMLButton.AddElements( 
   AddIntf: IAddScriptElements); 
 begin 
   AddIntf.AddIncludeFile('xmlshow.js'); 
 end; 
 
 function TCustomShowXMLButton.GetSubComponents: TObject; 
 begin 
   Result := nil; 
 end; 
 
 function TCustomShowXMLButton.ImplContent(Options: TWebContentOptions; 
   ParentLayout: TLayout): string; 
 var 
   Attrs: string; 
   Intf: ILayoutWebContent; 
   FormVarName: string; 
   RowSetVarName: string; 
 begin 
   AddQuotedAttrib(Attrs, 'NAME', Name); 
   AddQuotedAttrib(Attrs, 'STYLE', Style); 
   AddQuotedAttrib(Attrs, 'CLASS', StyleRule); 
   AddQuotedAttrib(Attrs, 'VALUE', Self.Caption); 
   AddCustomAttrib(Attrs, Custom); 
   if Assigned(XMLData.XMLBroker) then 
   begin 
     FormVarName := XMLData.XMLBroker.SubmitFormVarName; 
     RowSetVarName := XMLData.XMLBroker.RowSetVarName(nil);  // Row row set var name 
   end; 
   if not (coNoScript in Options.Flags) then 
     Result := 
       Format('<INPUT TYPE=BUTTON %0:s onclick=''if(%3:s)ShowXML(%1:s.%2:s);''>'#13#10, 
         [Attrs, RowSetVarName, XMLMethodName, sXMLReadyVar]) 
   else 
     Result := 
       Format('<INPUT TYPE=BUTTON %0:s>'#13#10, 
         [Attrs]); 
   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then 
     Result := Intf.LayoutButton(Result, GetLayoutAttributes); 
 end; 
 
 { TShowXMLButton } 
 
 constructor TShowXMLButton.Create(AOwner: TComponent); 
 begin 
   inherited; 
   DefaultCaption := sShowXML; 
   XMLMethodName := 'root'; 
 end; 
 
 { TShowDeltaButton } 
 
 constructor TShowDeltaButton.Create(AOwner: TComponent); 
 begin 
   inherited; 
   DefaultCaption := sShowDelta; 
   XMLMethodName := 'getDelta()'; 
 end; 
 
 另一种方法,使用msxml.dll,如下: 
 .... 
 .... 
 procedure TDHEDForm.OpenBtnClick(Sender: TObject); 
 var 
  pVIn : OleVariant; 
  Prompt : OleVariant; 
 begin 
   pVIn := ''; 
   Prompt := True; 
   DHtmlEdit1.LoadDocument(pVIn, Prompt); 
 end; 
 
 
 procedure TDHEDForm.SaveBtnClick(Sender: TObject); 
 var 
   vo, vb : OleVariant; 
 begin 
   vo := DHTMLEdit1.CurrentDocumentPath; 
   if (vo <> '') then  
   begin 
      vb := false; 
   end  
   else  
   begin 
      vo := ''; 
      vb := true; 
   end;                                           
   DHTMLEdit1.SaveDocument(vo, vb); 
 end; 
 
 
 procedure TDHEDForm.SaveAsClick(Sender: TObject); 
 var 
   vo, vb : OleVariant; 
 begin 
   vo := ''; 
   vb := true;    
   DHTMLEdit1.SaveDocument(vo, vb); 
 end; 
 ...
 
 
 //转自北京社区DELPHI版
 
  ---- 我每天都在努力,因为每天都要进步!
 沉迷网络,程序人生,这就是我!
 欢迎光临我的个人主页:示天工作室 
 
 网易北京社区 DELPHI版 版副发贴印                 | 
 
 
 |