📄 svcobjdemo_main.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 + -