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

📄 svcobjdemo_main.pas

📁 DCNF 采用RSOMC(Remote Service Object Method Call)远程服务对象方法调用机制,分层结构实现. 1.网络通信适配层 2.服务对象管理层 3.应用业务层(F
💻 PAS
字号:
unit svcObjDemo_Main;

interface
uses SysUtils,Classes,DB,ADODB,Variants,Provider,
dcnf_ObjectPool,dcnf_win32_TLB,dcnf_Units,dcnf_Provider,
uBasis_SvcObject;

type
  TDemoObjMgrCB=class(TInterfacedObject,IObjMgrCB)
  protected
    function createNewObj:Pointer;stdcall;
    procedure destroyObj(var obj:Pointer);stdcall;
  end;

  TDemoObject = class(TBasisSvcObject)
  private
  protected
    function onInit(const req:IRequestPacket):Longint;override;
    function doAppRequest(const req: IRequestPacket; const resp: IResponsePacket):Longint;override;

    procedure beforeUpdateRow(
      const DBScheme: string;
      const TableName: string;
      const Mode: TUpdateMode;
      const RecStatu: TUpdateStatus;
      const NewRows: OleVariant;
      const OldRows: OleVariant;
      var RsltMsg: WideString;
      var MaxErrors: integer);override;
    procedure afterUpdateRow(
      const DBScheme: string;
      const TableName: string;
      const Mode: TUpdateMode;
      const RecStatu: TUpdateStatus;
      const NewRows: OleVariant;
      const OldRows: OleVariant;
      var RsltMsg: WideString;
      var MaxErrors: integer);override;
    //\\

    //\\兼容midas标准数据提交事件
    procedure beforeApplyUpdates(
      Sender: TObject;
      var OwnerData: OleVariant);override;
    procedure afterApplyUpdates(
      Sender: TObject;
      var OwnerData: OleVariant);override;
    //\\
    
    procedure beforeGetRecords(
      const DBScheme: string;
      const TableName: string;
      const CommandText:WideString;
      const Params:TParams;
      var OwnerData:OleVariant);override;
    procedure afterGetRecords(
      DataSet: TDataSet;
      const DBScheme: string;
      const TableName: string;
      const Options:TGetRecordOptions;
      var OwnerData:OleVariant);override;
    procedure getMetaData(
      const DBScheme: string;
      const TableName: string;
      const ValidFields:TStringList;
      var RsltCode: integer);override;
  public
    constructor Create; override;
    destructor Destroy; override;
  end;

procedure getDemoObjMgrCB(out Obj);stdcall;

implementation

procedure getDemoObjMgrCB(out Obj);stdcall;
begin
  IObjMgrCB(Obj) := TDemoObjMgrCB.Create;
end;

{ TDemoObjMgrCB }

function TDemoObjMgrCB.createNewObj: Pointer;
begin
  Result := New(PSvcObj);
  PSvcObj(Result)^.FSvcObjIntf := TDemoObject.Create;
end;

procedure TDemoObjMgrCB.destroyObj(var obj: Pointer);
begin
  if obj <> nil then
  begin
    if PSvcObj(obj)^.FSvcObjIntf <> nil then
      PSvcObj(obj)^.FSvcObjIntf := nil;
  end;
end;

{ TDemoObject }

procedure TDemoObject.afterApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
  inherited;

end;

procedure TDemoObject.afterGetRecords(DataSet: TDataSet; const DBScheme,
  TableName: string; const Options: TGetRecordOptions;
  var OwnerData: OleVariant);
begin
  inherited;
end;

procedure TDemoObject.afterUpdateRow(const DBScheme, TableName: string;
  const Mode: TUpdateMode; const RecStatu: TUpdateStatus; const NewRows,
  OldRows: OleVariant; var RsltMsg: WideString; var MaxErrors: integer);
begin
  inherited;

end;

procedure TDemoObject.beforeApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
  inherited;

end;

procedure TDemoObject.beforeGetRecords(const DBScheme, TableName: string;
  const CommandText: WideString; const Params: TParams;
  var OwnerData: OleVariant);
begin
  inherited;

end;

procedure TDemoObject.beforeUpdateRow(const DBScheme, TableName: string;
  const Mode: TUpdateMode; const RecStatu: TUpdateStatus; const NewRows,
  OldRows: OleVariant; var RsltMsg: WideString; var MaxErrors: integer);
begin
  inherited;

end;

constructor TDemoObject.Create;
begin
  inherited;

end;

destructor TDemoObject.Destroy;
begin

  inherited;
end;

function TDemoObject.doAppRequest(const req: IRequestPacket;
  const resp: IResponsePacket): Longint;
var
  svcMethod:string;
begin
  svcMethod := trim(req.getHeaderValueByName('Method'));
  if svcMethod = 'Test' then
  begin
    resp.addParam('DateTime',Now());
  end;
  Result := S_OK;
end;

procedure TDemoObject.getMetaData(const DBScheme, TableName: string;
  const ValidFields: TStringList; var RsltCode: integer);
begin
  inherited;

end;

function TDemoObject.onInit(const req: IRequestPacket): Longint;
begin
  Result := inherited onInit(req);
end;

end.

⌨️ 快捷键说明

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