⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 client_ds.pas

📁 Delphi 应用举例
💻 PAS
字号:
unit client_ds;

interface

uses
  SysUtils,
  Classes,
  Controls,
  IWControl,IWForm,iwserver,
  IWHTMLTag,IWDsnPaint,//;//,IWDsnPaintHandlers
  IWDBStdCtrls,DBCtrls,IWFileReference,
  Provider,DBClient,DB,IWHiddenField
  ,StrUtils;

type

  TIWClientDataSet=class(TIWHiddenField)
  private
    fdataset:Tdataset;//就对这个对象进行包装
    fcdataset,fdelta_cds:Tclientdataset;
    //fprvder,tmpprvder:TDataSetProvider;
    fprvder:TDataSetProvider;
    //fdtmdl:Tdatamodule;
   
    procedure SetValue(const AValue: string);override;
    procedure set_dataset(value:Tdataset);
    function get_dataset:Tdataset;
    function get_xml:string;

    //
    procedure set_active(value:boolean);
    function get_active:boolean;
    function f_isreadonly:boolean;

    procedure prepare_xml(var xml_str:string);
  public
   
    //
    function RenderHTML: TIWHTMLTag; override;
    function getValue:string; override;
    procedure post;
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
    //
    procedure open;
    procedure close;
    function get_crs_nm:string;
    
    property is_readonly:boolean read f_isreadonly;
  published
    property dataset:Tdataset read get_dataset write set_dataset;
    property active:boolean read get_active write set_active;
  end;  
procedure Register;
//
//procedure prepare_xml(var xml_str:string);
//
implementation
 {$R db1.RES}
 {$R db2.RES}
 {$R db3.RES}
 {$R disp1.RES}
 {$R disp2.RES}
 {$R edit.RES}
uses IWResourceStrings,SWSystem,Variants,xmldom, XMLIntf, msxmldom, XMLDoc;
procedure Register;
begin
  RegisterComponents('test', [TIWClientDataSet]);
end;


procedure TIWClientDataSet.prepare_xml(var xml_str:string);
var node,n:IXMLNode;
    i:integer;
    XMLDocument1:TXMLDocument;
begin
    exit;
    //rwebapplication.
    XMLDocument1:=TXMLDocument.Create(self.Form);
    try
        try
            XMLDocument1.XML.Text:=xml_str;
            XMLDocument1.Active:=true;

            node:=XMLDocument1.Node.childnodes[0].childnodes[1];
            i:=0;
            while i< node.ChildNodes.Count do begin
                n:=node.ChildNodes[i];
                if n.HasAttribute('RowState') then  begin
                    node.ChildNodes.Remove(n);
                    if (n.Attributes['RowState']='1') or (n.Attributes['RowState']='2') then
                        continue
                    else
                        node.ChildNodes.Insert(0,n);
                end;

                i:=i+1;
            end;

            xml_str:= XMLDocument1.XML.text;
        except
            xml_str:='';
        end;
    finally
        XMLDocument1.Free;
    end;


end;

constructor TIWClientDataSet.Create(AOwner: TComponent);
begin
    inherited create(AOwner);
    fprvder:=TDataSetProvider.Create(self);
    fdelta_cds:=Tclientdataset.Create(self);
    fcdataset:=Tclientdataset.Create(self);
    fcdataset.SetProvider(fprvder);
    
    if not FDesignMode then begin
       Giwserver.AddInternalFile('IW_JS_XMLDB3');
       Giwserver.AddInternalFile('IW_JS_XMLDB2');
       Giwserver.AddInternalFile('IW_JS_XMLDB1');
       Giwserver.AddInternalFile('IW_JS_XMLDISP2');
       Giwserver.AddInternalFile('IW_JS_XMLDISP1');
       Giwserver.AddInternalFile('IW_JS_XMLEDIT');

        with (AOwner as TIWForm) do begin

            if ScriptFiles.IndexOf(webapplication.URLBase+'/js/XMLDB3.JS')<0 then ScriptFiles.Add(webapplication.URLBase+'/js/XMLDB3.JS');
            if ScriptFiles.IndexOf(webapplication.URLBase+'/js/XMLDB2.JS')<0 then ScriptFiles.Add(webapplication.URLBase+'/js/XMLDB2.JS');
            if ScriptFiles.IndexOf(webapplication.URLBase+'/js/XMLDB1.JS')<0 then ScriptFiles.Add(webapplication.URLBase+'/js/XMLDB1.JS');
            if ScriptFiles.IndexOf(webapplication.URLBase+'/js/XMLDISP2.JS')<0 then ScriptFiles.Add(webapplication.URLBase+'/js/XMLDISP2.JS');
            if ScriptFiles.IndexOf(webapplication.URLBase+'/js/XMLDISP1.JS')<0 then ScriptFiles.Add(webapplication.URLBase+'/js/XMLDISP1.JS');
            if ScriptFiles.IndexOf(webapplication.URLBase+'/js/XMLEDIT.JS')<0 then ScriptFiles.Add(webapplication.URLBase+'/js/XMLEDIT.JS');
        end;
    end;
    {with (AOwner as TIWForm) do begin
        if ScriptFiles.IndexOf('/files/XMLDB3.JS')<0 then ScriptFiles.Add('/files/XMLDB3.JS');
        if ScriptFiles.IndexOf('/files/XMLDB2.JS')<0 then ScriptFiles.Add('/files/XMLDB2.JS');
        if ScriptFiles.IndexOf('/files/XMLDB1.JS')<0 then ScriptFiles.Add('/files/XMLDB1.JS');
        if ScriptFiles.IndexOf('/files/XMLDISP2.JS')<0 then ScriptFiles.Add('/files/XMLDISP2.JS');
        if ScriptFiles.IndexOf('/files/XMLDISP1.JS')<0 then ScriptFiles.Add('/files/XMLDISP1.JS');
        if ScriptFiles.IndexOf('/files/XMLEDIT.JS')<0 then ScriptFiles.Add('/files/XMLEDIT.JS');
    end;}
end;
destructor TIWClientDataSet.destroy;
begin
   try
      fprvder.Free;
      fdelta_cds.free;
      fcdataset.free;
   finally
      inherited destroy;
   end;
end;
procedure TIWClientDataSet.SetValue(const AValue: string);
var i:integer;

begin
   if  AValue='' then  exit;
   if  pos('undefined',AValue)>0 then exit;
   fdelta_cds.Close;
   try
     fdelta_cds.XMLData:=AValue;
   except
     exit;
   end;
   //fcdataset.SetProvider(nil);
   i:=0;
   try
       fprvder.ApplyUpdates(fdelta_cds.Data,0,i) ;
       fcdataset.Refresh;
       //tmpprvder.ApplyUpdates(fdelta_cds.Data,0,i) ;
       if i>0 then
       fdelta_cds.Close;
   except
   end
end;
function TIWClientDataSet.getValue:string;
begin
   result:='';
end;
procedure TIWClientDataSet.set_dataset(value:Tdataset);
begin
   fdataset:=value;
   fprvder.DataSet:=fdataset;
   fprvder.ResolveToDataSet:=true;
   fprvder.UpdateMode:=upWhereKeyOnly;
end;
function TIWClientDataSet.get_dataset:Tdataset;
begin
   result:=fdataset;
end;
procedure TIWClientDataSet.post;
begin
   with fcdataset do begin
        if ChangeCount>0 then try
           ApplyUpdates(0);
        except
        end; 
   end;
end;

function TIWClientDataSet.get_xml:string;
var i:integer;
begin
    result:='';
    if self.fdataset=nil then exit;
    if not fcdataset.Active then
       fcdataset.Open;

    result:=fcdataset.XMLData;

    i:=pos('<DATAPACKET',result);
    delete(result,1,i-1);
    prepare_xml(result);
end;
///!!!!!!!!!!!!!!!!!!!!!
function TIWClientDataSet.get_crs_nm:string;
begin
    result:=UpperCase(name)+'_XML_RS';
end;


function TIWClientDataSet.RenderHTML: TIWHTMLTag;
var tmp:TIWHTMLTag;
    s,ss,nm:string;
    i:integer;
begin
    tmp:=inherited RenderHTML;
    result:=TIWHTMLTag.CreateTag('span');
    result.AddStringParam('name',HTMLName+'_span');
    result.AddStringParam('id',HTMLName+'_span');
    result.Contents.AddTagAsObject(tmp);
    //
    nm:=HTMLName+'_grp_modi_flg';
    result.Contents.AddText('<input type=hidden name="'+nm+'" id="'+nm+'" size="1">');
    //
    s:=get_xml;
    if s='' then exit;
    s:='<xml id='+uppercase(name)+'_DOC>'+s+'</xml>';
    result.Contents.AddText(s);

    result.Contents.AddText('<script language="Javascript1.2" type="text/javascript"> ');
    result.Contents.AddText('var SubmitForm = document.forms[''SubmitForm''];');
    result.Contents.AddText('var '+UpperCase(name)+'_XML_RS = new xmlRowSet('+UpperCase(name)+'_DOC, null, null);');
    
    result.Contents.AddText('</script>');


end;
procedure TIWClientDataSet.set_active(value:boolean);
begin
    if value then open
    else close;
end;
function TIWClientDataSet.get_active:boolean;
begin
    result:=fcdataset.Active
end;
procedure TIWClientDataSet.open;
begin
    if assigned(fdataset) then begin
       //fcdataset.Active:=true;
       self.fdataset.Open;
       fcdataset.SetProvider(fprvder);
       fcdataset.Open;
    end;
end;
procedure TIWClientDataSet.close;
begin
    if assigned(fdataset) then fcdataset.close;
end;
function TIWClientDataSet.f_isreadonly:boolean;
begin
   result:=self.fdelta_cds.ReadOnly;
end;


initialization
  //IWRegisterPaintHandler('TIWclientButton', TIWPain.tHandlerButton);
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -