{*******************************************************}
{ }
{ Business Platform System Core Library }
{ }
{ Copyright (c) Justep Software Corporation }
{ }
{*******************************************************}
unit SYSTEMCORE;
interface
uses
Business.System, Business.Data, Business.Forms, Business.Model,
Business.Model.Org, Business.Model.Flow,
SystemUtils, AbstractSystemInterface;
type
{ TUITheme }
TUITheme = class
private
FSpace: string;
FSystemUISpace: string;
function InternalFixURL(const ASpace, AURL: string): string;
function CreateForm(AContext: TContext; const AURL: string): TForm;
public
constructor Create;
function FixURL(const AURL: string): string;
{ 获取系统界面方案空间的 URL ，如果没有定义就返回 “Biz:\System\DefaultUserInterface”}
function GetSystemUISpace: string;
{ 传入一个操作者对象，获取该操作者界面方案空间的 URL ，如果没有定义过，就返回 GetSystemUISpace 方法的值 }
function GetUserUISpace(AOperator: TOperator): string;
property Space: string read FSpace;
end;
{ TFuncManager }
TFuncRunNotifyEvent = procedure(Sender: TObject; Func: TFunc; Modal: Boolean) of object;
TFuncNotifyEvent = procedure(Sender: TObject; Func: TFunc) of object;
TRunFuncEvent = procedure(Context: TContext; const UID, FuncURL, Params: string; UseUI: Boolean; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean) of object;
TFuncManager = class(TObject)
private
FRunningFuncs: TList;
FNeedFreeFuncs: TComponentList;
FNotifiedFuncs: TList;
FFuncRecycleTimer: TTimer;
FFuncRecycleDisableCount: Integer;
FRunningFuncIDs: TStringList;
FOnRunFunc: TRunFuncEvent;
FOnFuncRun: TFuncRunNotifyEvent;
FOnFuncActivate: TFuncNotifyEvent;
FOnFuncTerminate: TFuncNotifyEvent;
function RunFunc(AContext: TContext; AFuncItem: TOperatorFuncItem; const AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc; overload;
procedure InternalRunFunc(AFunc: TFunc; const AParams: string; AUniqueIDs: TStrings; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean); overload;
procedure InternalRunFunc(AFunc: TFunc; const AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean); overload;
function InternalRunFunc(AContext: TContext; const AFuncURL, AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc; overload;
procedure InternalFuncTerminateNotify(Func: TFunc; Force: Boolean);
procedure FuncTerminate(Func: TFunc);
procedure FreeFunc(Func: TFunc);
procedure RecycleFuncs;
procedure FuncRecycleOnTimer(Sender: TObject);
procedure DisableFuncRecycle;
procedure EnableFuncRecycle;
{ function FindOperatorPositionByDeptID(const ADeptID: string;
AOperator: TOperator): TOperatorPosition;}
procedure DoFuncRun(Func: TFunc; Modal: Boolean);
procedure DoFuncActivate(Func: TFunc);
procedure DoFuncTerminate(Func: TFunc);
function GetRunningFuncCount: Integer;
function GetRunningFunc(Index: Integer): TFunc;
function GetFuncURLByTask(ATask: TTask): string;
function FindTaskRunPosition(AContext: TContext; T: TTask;
ATaskMessage: TTaskMessage): TOperatorPosition;
property RunningFuncIDs: TStringList read FRunningFuncIDs;
public
constructor Create;
destructor Destroy; override;
function CreateFunc(AContext: TContext; const AFuncURL: string): TFunc;
function FindRunFuncContext(AContext: TContext; FuncItem: TOperatorFuncItem): TContext; overload;
function FindRunFuncContext(AContext: TContext; const AFuncURL: string): TContext; overload;
function CanRunFunc(AContext: TContext; const AFuncURL: string): Boolean;
function CanRunFuncByPosition(AContext: TContext; const AFuncURL: string): Boolean;
{ 激活功能，触发 OnFuncActivate 事件 }
procedure ActivateFunc(Func: TFunc);
{ 激活任务功能，触发 OnFuncActivate 事件 }
procedure ActivateTask(Task: TTask);
{ 获取功能的 UniqueID }
static function GetFuncUniqueID(AContext: TContext; const AFuncURL, AParams: string): string; overload;
static function GetFuncUniqueID(const AFuncURL, AParams, ADeptID, APositionID, APersonID: string): string; overload;
{ 根据 UniqueID 查找正在运行的功能 }
function FindRunning(const AUniqueID: string): TFunc;
{ 是否是权限无关的功能 }
function IsDefaultFunc(const AFuncURL: string): Boolean;
{ 运行功能 }
function RunFunc(AContext: TContext; const AUniqueID, AFuncURL, AParams: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc; overload;
procedure RunFunc(AContext: TContext; const AUniqueID, AFuncURL, AParams: string; UseUI: Boolean; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean); overload;
//function RunFunc(const AFuncURL, ADeptID, APositionID, APersonID, AParams: string): TFunc; overload;
{ 根据指定的UniqueID，将指定的功能实例运行起来 }
procedure RunFunc(AFunc: TFunc; const AParams, AUniqueID: string); overload;
procedure RunFunc(AFunc: TFunc; const AParams: string; AUniqueIDs: TStrings); overload;
{ 获取任务的 UniqueID }
static function GetTaskUniqueID(ATask: TTask): string;
{ 任务是否正在运行 }
function IsTaskRunning(ATask: TTask): Boolean;
//以下方法不严格，兼容性保留
{ 运行单个任务 }
function RunTask(AContext: TContext; ATask: TTask): TFunc; overload;
function RunTask(APosition: TOperatorPosition; ATask: TTask): TFunc; overload;
{ 运行一批任务 }
function RunTasks(AContext: TContext; ATasks: TList): TFunc; overload;
function RunTasks(APosition: TOperatorPosition; ATasks: TList): TFunc; overload;
function RunTasks(AContext: TContext; ATasks: TList; AExecutor: TOrgURL): TFunc; overload;
function RunTasks(AContext: TContext; ATasks, ATaskMessages: TList;
AutoDetectContext: Boolean): TFunc; overload;
function RunTasks(AContext: TContext; ATasks, ATaskMessages: TList;
AExecutor: TOrgURL): TFunc; overload;
{ 获取功能的显示名称 }
static function GetFuncDisplayText(Func: TFunc): string;
{ 结束单个功能，Force 参数指明是否强制结束 }
function TerminateFunc(Func: TFunc; Force: Boolean): Boolean;
{ 结束一批功能，Force 参数指明是否强制结束 }
function TerminateFuncs(Funcs: TList; Force: Boolean): Boolean;
{ 结束所有运行的功能，Force 参数指明是否强制结束 }
function TerminateAllFuncs(Force: Boolean): Boolean;
{ 获取指定环境中正在运行的功能列表 }
procedure GetRunningFuncs(Funcs: TList; Context: TContext);
{ 运行的功能数 }
property RunningFuncCount: Integer read GetRunningFuncCount;
{ 根据指定的索引号获取运行的功能实例 }
property RunningFuncs[Index: Integer]: TFunc read GetRunningFunc;
{ 以下三个事件一般由主界面窗体接管。其他窗体除非是主窗体，否则勿需接管 }
{ 当运行功能的时候发生 }
property OnFuncRun: TFuncRunNotifyEvent read FOnFuncRun write FOnFuncRun;
{ 当激活功能的时候发生 }
property OnFuncActivate: TFuncNotifyEvent read FOnFuncActivate write FOnFuncActivate;
{ 结束功能的时候发生 }
property OnFuncTerminate: TFuncNotifyEvent read FOnFuncTerminate write FOnFuncTerminate;
property OnRunFunc: TRunFuncEvent read FOnRunFunc write FOnRunFunc;
end;
{ TSystemInterfaceManager }
TSystemInterfaceManager = class(TObject)
private
FLoaded: TStringList;
function CreateNew(const URL: string): TAbstractSystemInterface;
function Find(const URL: string): TAbstractSystemInterface;
procedure Clear;
public
constructor Create;
destructor Destroy; override;
function Get(const URL: string): TAbstractSystemInterface;
end;
{ TSystemCore }
TSYSTEMCORE = class(TBizLibrary)
public
static procedure Init;
static procedure Uninit;
static function SystemInterface: TAbstractSystemInterface;
static function FuncManager: TFuncManager;
static function UITheme: TUITheme;
static function FlowManager: TFlowManager;
{ 当前操作者 }
static function Operator: TOperator;
{ 登录 }
// Logon 兼容性保留
static function Logon(const ALogonID, APassword: string): Boolean;
static function LogonEx(const ALogonID, APassword: string; APerson: TPersonMember): Boolean;
{ 注销 }
static procedure Logoff;
static function CanRelogon: Boolean;
static procedure SetOperator(AOperator: TOperator);
static function CreateBizObject(AContext: TContext; const ABizURL: string): TBizObject;
static function GetBizObject(AContext: TContext; const ABizURL: string): TBizObject;
end;
{ TDotNetObjectList }
TDotNetObjectList = class
private
FArray: array of object;
FCount: Integer;
function GetItem(Index: Integer): object;
procedure SetItem(Index: Integer; O: object);
procedure SetCount(C: Integer);
procedure CheckArrayLength(L: Integer);
public
procedure Add(O: object); overload;
procedure Add(List: TDotNetObjectList); overload;
procedure Delete(Index, ACount: Integer); overload;
procedure Delete(Index: Integer); overload;
procedure Insert(Index: Integer; O: array of object);
procedure Clear;
function IndexOf(O: object): Integer;
function Remove(O: object): Integer;
property Count: Integer read FCount write SetCount;
property Items[Index: Integer]: object read GetItem write SetItem; default;
end;
{ TFlowDefaultExecutorManage }
TFlowCommandNotifyEvent = procedure (Sender: TObject; ACommand: TFlowCommand) of Object;
TFlowManager = class(TObject)
private
FOnCreateFlowTasks: TFlowCommandNotifyEvent;
FAfterFlowCommand: TFlowCommandNotifyEvent;
FBeforeFlowCommand: TFlowCommandNotifyEvent;
FOnPrepareTasksCommand: TFlowCommandNotifyEvent;
FOnPrepareFlowsCommand: TFlowCommandNotifyEvent;
FOnPrepareFlowTasksCommand: TFlowCommandNotifyEvent;
procedure DoEvent(FEvent: TFlowCommandNotifyEvent; ACommand: TFlowCommand);
public
property OnCreateFlowTasks: TFlowCommandNotifyEvent read FOnCreateFlowTasks write FOnCreateFlowTasks;
property AfterFlowCommand: TFlowCommandNotifyEvent read FAfterFlowCommand write FAfterFlowCommand;
property BeforeFlowCommand: TFlowCommandNotifyEvent read FBeforeFlowCommand write FBeforeFlowCommand;
property OnPrepareTasksCommand: TFlowCommandNotifyEvent read FOnPrepareTasksCommand write FOnPrepareTasksCommand;
property OnPrepareFlowsCommand: TFlowCommandNotifyEvent read FOnPrepareFlowsCommand write FOnPrepareFlowsCommand;
property OnPrepareFlowTasksCommand: TFlowCommandNotifyEvent read FOnPrepareFlowTasksCommand write FOnPrepareFlowTasksCommand;
procedure doOnCreateFlowTasks(ACommand: TFlowCommand);
procedure doAfterFlowCommand(ACommand: TFlowCommand);
procedure doBeforeFLowCommand(ACommand: TFlowCommand);
procedure doOnPrepareTasksCommand(ACommand: TFlowCommand);
procedure doOnPrepareFlowsCommand(ACommand: TFlowCommand);
procedure doOnPrepareFlowTasksCommand(ACommand: TFlowCommand);
end;
{ TBizMessages }
TBizMessages = class
public
static procedure Notify(AContext: TContext; const AMsg: string; LogonContext: TContext);
static function LogonMessage: string;
static function LogoffMessage: string;
end;
//add by wdx
TLogonMessage = class(TBizMessage)
private
FContext: TContext;
public
constructor Create(const AMsg: string; AContext: TContext);
property Context: TContext read FContext write FContext;
end;
{ TBizSystemDefine }
TBizSystemDefine = class
private
FID: string;
FDisplayName: string;
FPath: string;
FVisible: Boolean;
public
property ID: string read FID write FID;
property DisplayName: string read FDisplayName write FDisplayName;
property Path: string read FPath write FPath;
property Visible: Boolean read FVisible write FVisible;
end;
{ TBizSystemDefineList }
TBizSystemDefineList = class(TDotNetObjectList)
private
procedure Init;
function CreateBizSystemInfo(ADataSet: TDataSet): TBizSystemDefine;
public
constructor Create;
static function Count: Integer;
static function Items(Index: Integer): TBizSystemDefine;
end;
const
UISpaceID = 'UISpace';
implementation
const
DefaultUIURL = 'Biz:\SYSTEM\CompactStyle';
var
FSystemMessageReceive: TSystemMessageReceive;
FUITheme: TUITheme;
FFuncManager: TFuncManager;
FOperator: TOperator;
FCanRelogon: Boolean;
FSetOperator: Boolean;
FSystemInterfaceManager: TSystemInterfaceManager;
FFlowManager: TFlowManager;
FBizSystemInfos: TBizSystemDefineList;
{ TSystemCore }
static procedure TSYSTEMCORE.Init;
begin
FCanRelogon := True;
FSystemInterfaceManager := TSystemInterfaceManager.Create;
FUITheme := TUITheme.Create;
FSystemMessageReceive := TSystemMessageReceive.Create(BizSys.GlobalContext);
FFuncManager := TFuncManager.Create;
FFlowManager := TFlowManager.Create;
FBizSystemInfos := TBizSystemDefineList.Create;
end;
static procedure TSYSTEMCORE.Uninit;
begin
FBizSystemInfos := nil;
FFlowManager.Free;
FFuncManager.Free;
FSystemMessageReceive.Free;
FUITheme := nil;
FSystemInterfaceManager.Free;
end;
static function TSYSTEMCORE.SystemInterface: TAbstractSystemInterface;
begin
Result := FSystemInterfaceManager.Get(UITheme.Space);
end;
static function TSYSTEMCORE.FuncManager: TFuncManager;
begin
Result := FFuncManager;
end;
static function TSYSTEMCORE.UITheme: TUITheme;
begin
Result := FUITheme;
end;
static function TSYSTEMCORE.FlowManager: TFlowManager;
begin
Result := FFlowManager;
end;
static function TSYSTEMCORE.Operator: TOperator;
begin
Result := FOperator;
end;
procedure CheckLogon(Logon: Boolean);
const
Msg01 = '并没有登录，请登录后再试';
Msg02 = '已经登录了，请注销后再试';
begin
if (FOperator = nil) = Logon then
if FOperator = nil then
raise Exception.Create(Msg01)
else
raise Exception.Create(Msg02);
end;
static function TSYSTEMCORE.Logon(const ALogonID, APassword: string): Boolean;
begin
Result := LogonEx(ALogonID, APassword, nil);
end;
function GetSystemDefaultFuncURLs: TStringArray;
begin
//需要提供注册机制
Result := ['Biz:\SYSTEM\OrgSetting.Func'];
if BizSys.BizSystem.URLExists('Biz:\OPERATION\DocSpace') then
begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1] := 'Biz:\OPERATION\DOCSPACE\DocAccessSettingFunc.Func';
end;
if BizSys.BizSystem.URLExists('Biz:\OPERATION\DecisionSpace') then
begin
SetLength(Result, Length(Result) + 2);
Result[Length(Result) - 2] := 'Biz:\OPERATION\DECISIONSPACE\DECISIONINIT.FUNC';
Result[Length(Result) - 1] := 'Biz:\OPERATION\DECISIONSPACE\DecisionAccessSettingFunc.FUNC';
end;
if BizSys.BizSystem.URLExists('Biz:\JEWIMPHARMA\SCM') then
begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1] := 'Biz:\JEWIMPHARMA\SCM\ScmInitFunc.Func';
end;
end;
static function TSYSTEMCORE.LogonEx(const ALogonID, APassword: string; APerson: TPersonMember): Boolean;
const
ErrMsg = '用户%s不能登陆，因为没有分配岗位或者用户%s已经被其他用户代理.';
var
lOperator: TOperator;
lLogonContext: TContext;
lOperatorPositions: array of TOperatorPosition;
begin
CheckLogon(False);
Opr.OperatorLoader.SystemManagerFuncURLs := GetSystemDefaultFuncURLs;
lOperator := Opr.Logon(ALogonID, APassword);
Result := lOperator <> nil;
if Result then
begin
if not Opr.IsSystemManager(ALogonID) and
(lOperator.PositionCount = 0) then
begin
Opr.Logoff(lOperator);
raise Exception.CreateFmt(ErrMsg, [ALogonID, ALogonID]);
end;
FOperator := lOperator;
UITheme.FSpace := UITheme.GetUserUISpace(lOperator);
if Assigned(SystemInterface.OnLogonSucceed) then
SystemInterface.OnLogonSucceed(FOperator);
if APerson <> nil then
begin
if FOperator.FindPosition(APerson.Parent.Parent.ID, APerson.Parent.ID, APerson.ID, lOperatorPositions) then
lLogonContext := lOperatorPositions[0].Context
else
raise Exception.Create('不能找到当前登陆者的岗位！');
end else
lLogonContext := FOperator.Context;
TBizMessages.Notify(BizSys.GlobalContext, TBizMessages.LogonMessage, lLogonContext);
end;
end;
static procedure TSYSTEMCORE.Logoff;
var
lFuncs: TList;
begin
if not CanRelogon then
raise Exception.Create('不能注销');
TBizMessages.Notify(BizSys.GlobalContext, TBizMessages.LogoffMessage, nil);
CheckLogon(True);
lFuncs := TList.Create;
try
FuncManager.GetRunningFuncs(lFuncs, Operator.Context);
FuncManager.TerminateFuncs(lFuncs, True);
finally
lFuncs.Free;
end;
FuncManager.RecycleFuncs;
if FSetOperator then
begin
FSetOperator := False;
FOperator := nil;
end
else
Opr.Logoff(FOperator);
end;
static function TSYSTEMCORE.CanRelogon: Boolean;
begin
Result := FCanRelogon;
end;
static procedure TSYSTEMCORE.SetOperator(AOperator: TOperator);
begin
if not FCanRelogon or (FOperator <> nil) then
raise Exception.Create('已经登录');
FOperator := AOperator;
FSetOperator := True;
FCanRelogon := Borland.Delphi.Windows.GetModuleHandle('rtdbg.dll') <> 0;
end;
static function TSYSTEMCORE.CreateBizObject(AContext: TContext; const ABizURL: string): TBizObject;
var
lBizClassURL: TBizClassURL;
begin
lBizClassURL := TBizClassURL.Create;
try
lBizClassURL.BizURL.URL := ABizURL;
Result := BizSys.BizService.CreateBizObject(lBizClassURL, AContext);
finally
lBizClassURL.Free;
end;
end;
static function TSYSTEMCORE.GetBizObject(AContext: TContext; const ABizURL: string): TBizObject;
var
lBizClassURL: TBizClassURL;
begin
lBizClassURL := TBizClassURL.Create;
try
lBizClassURL.BizURL.URL := ABizURL;
Result := AContext.GetBizObject(lBizClassURL);
finally
lBizClassURL.Free;
end;
end;
{ TUITheme }
constructor TUITheme.Create;
begin
inherited;
FSpace := GetSystemUISpace;
end;
function TUITheme.CreateForm(AContext: TContext; const AURL: string): TForm;
var
lBizClassURL: TBizClassURL;
begin
lBizClassURL := TBizClassURL.Create;
try
lBizClassURL.BizURL.URL := FixURL(AURL);
Result := BizSys.BizService.CreateBizForm(lBizClassURL, AContext);
finally
lBizClassURL.Free;
end;
end;
function TUITheme.FixURL(const AURL: string): string;
begin
Result := InternalFixURL(FSpace, AURL);
end;
function TUITheme.InternalFixURL(const ASpace, AURL: string): string;
var
lURL: TBizURL;
begin
lURL := TBizURL.Create;
try
lURL.URL := ASpace + AURL;
if BizSys.BizSystem.URLExists(lURL) then
Result := lURL.URL
else
if SysUtils.SameText(FSystemUISpace, ASpace) then
Result := DefaultUIURL + AURL
else
Result := InternalFixURL(FSystemUISpace, AURL);
finally
lURL.Free;
end;
end;
function TUITheme.GetSystemUISpace: string;
begin
if FSystemUISpace = '' then
FSystemUISpace := SysSrv.SysService.Config.Attributes('uitheme/default', DefaultUIURL);
Result := FSystemUISpace;
end;
function TUITheme.GetUserUISpace(AOperator: TOperator): string;
begin
Result := '';
if not SysUtils.SameText(SysSrv.SysService.Config.Attributes('uitheme/allowuser', 'false'), 'true') or
not ExtUtils.ReadUserInfo(AOperator.ID, UISpaceID, Result, nil) or
(Result = '') then
Result := GetSystemUISpace;
end;
{ TFuncManager }
constructor TFuncManager.Create;
begin
inherited;
FNotifiedFuncs := TList.Create;
FNeedFreeFuncs := TComponentList.Create(False);
FRunningFuncs := TList.Create;
FRunningFuncIDs := TStringList.Create;
FRunningFuncIDs.Duplicates := TDuplicates.dupIgnore;
FRunningFuncIDs.Sorted := True;
FFuncRecycleTimer := TTimer.Create(nil);
FFuncRecycleTimer.Enabled := False;
FFuncRecycleTimer.OnTimer := FuncRecycleOnTimer;
end;
destructor TFuncManager.Destroy;
begin
RecycleFuncs;
FFuncRecycleTimer.Free;
FRunningFuncIDs.Free;
FRunningFuncs.Free;
FNeedFreeFuncs.Free;
FNotifiedFuncs.Free;
inherited;
end;
function TFuncManager.CreateFunc(AContext: TContext; const AFuncURL: string): TFunc;
var
lBizObject: TBizObject;
lBizClassURL: TBizClassURL;
begin
lBizClassURL := TBizClassURL.Create;
Try
lBizClassURL.BizURL.URL := AFuncURL;
lBizObject := BizSys.BizService.CreateBizObject(lBizClassURL, AContext);
try
Result := lBizObject as TFunc;
except
lBizObject.Free;
raise;
end;
finally
lBizClassURl.Free;
end;
end;
function TFuncManager.FindRunFuncContext(AContext: TContext; FuncItem: TOperatorFuncItem): TContext;
var
Operator: TOperator;
OperatorContext: TContext;
CurrentPositionContext: TContext;
CurrentPosition: TOperatorPosition;
begin
OperatorContext := AContext.FindParentContext(BizSys.IL_PERSON);
if OperatorContext = nil then
begin
Result := nil;
Exit;
end;
Operator := OperatorContext.Owner as TOperator;
if FuncItem.PositionCount = 0 then
begin
Result := Operator.Context;
Exit;
end;
CurrentPositionContext := AContext.FindParentContext(BizSys.IL_POSITION);
if CurrentPositionContext = nil then
CurrentPositionContext := TContextUtils.GetDefaultOperatorPosition(Operator.Context).Context;
CurrentPosition := CurrentPositionContext.Owner as TOperatorPosition;
if FuncItem.Has(CurrentPosition) then
begin
Result := CurrentPosition.Context;
Exit;
end;
Result := FuncItem.Positions[0].Context;
end;
function TFuncManager.FindRunFuncContext(AContext: TContext;
const AFuncURL: string): TContext;
var
Operator: TOperator;
OperatorContext: TContext;
FuncItem: TOperatorFuncItem;
begin
OperatorContext := AContext.FindParentContext(BizSys.IL_PERSON);
if OperatorContext = nil then
begin
Result := nil;
Exit;
end;
Operator := OperatorContext.Owner as TOperator;
FuncItem := Operator.FuncItems.Find(AFuncURL);
if FuncItem = nil then
begin
Result := nil;
Exit;
end;
Result := FindRunFuncContext(AContext, FuncItem);
end;
function TFuncManager.CanRunFunc(AContext: TContext; const AFuncURL: string): Boolean;
var
Operator: TOperator;
begin
Result := IsDefaultFunc(AFuncURL);
if not Result then
begin
Operator := AContext.GetParentContext(BizSys.IL_PERSON).Owner as TOperator;
Result := Operator.FuncItems.Find(AFuncURL) <> nil;
end;
end;
function TFuncManager.CanRunFuncByPosition(AContext: TContext; const AFuncURL: string): Boolean;
var
Position: TOperatorPosition;
Operator: TOperator;
FuncItem: TOperatorFuncItem;
begin
Position := TContextUtils.FindOperatorPosition(AContext);
if Position = nil then
Result := CanRunFunc(AContext, AFuncURL)
else
begin
Result := IsDefaultFunc(AFuncURL);
if not Result then
begin
Operator := AContext.GetParentContext(BizSys.IL_PERSON).Owner as TOperator;
FuncItem := Operator.FuncItems.Find(AFuncURL);
Result := (FuncItem <> nil) and FuncItem.Has(Position);
end;
end;
end;
procedure TFuncManager.InternalRunFunc(AFunc: TFunc; const AParams: string; AUniqueIDs: TStrings; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean);
var
I: Integer;
lFunc: TFunc;
begin
if AUniqueIDs <> nil then
for I := 0 to AUniqueIDs.Count - 1 do
begin
lFunc := FindRunning(AUniqueIDs[I]);
if lFunc <> nil then
raise Exception.CreateFmt('功能%s与功能%s运行唯一冲突', [
AFunc.DisplayName, lFunc.DisplayName]);
end;
if BeforeRunFunc <> nil then
BeforeRunFunc(Self, AFunc);
AFunc.Run(AParams);
try
if not AFunc.Terminated then
DoFuncRun(AFunc, Modal);
if not AFunc.Terminated then
begin
AFunc.TerminateEvent.Add(FuncTerminate);
FRunningFuncs.Add(AFunc);
if AUniqueIDs <> nil then
for I := 0 to AUniqueIDs.Count - 1 do
FRunningFuncIDs.AddObject(AUniqueIDs[I], AFunc);
ActivateFunc(AFunc);
end;
except
AFunc.Terminate;
raise;
end;
end;
procedure TFuncManager.InternalRunFunc(AFunc: TFunc; const AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean);
var
lFunc: TFunc;
begin
if AUniqueID <> '' then
begin
lFunc := FindRunning(AUniqueID);
if lFunc <> nil then
raise Exception.CreateFmt('功能%s与功能%s运行唯一冲突', [
AFunc.DisplayName, lFunc.DisplayName]);
end;
if BeforeRunFunc <> nil then
BeforeRunFunc(Self, AFunc);
AFunc.Run(AParams);
try
if not AFunc.Terminated then
DoFuncRun(AFunc, Modal);
if not AFunc.Terminated then
begin
AFunc.TerminateEvent.Add(FuncTerminate);
FRunningFuncs.Add(AFunc);
if AUniqueID <> '' then
FRunningFuncIDs.AddObject(AUniqueID, AFunc);
ActivateFunc(AFunc);
end;
except
AFunc.Terminate;
raise;
end;
end;
function TFuncManager.InternalRunFunc(AContext: TContext; const AFuncURL, AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc;
begin
if AUniqueID <> '' then
begin
Result := FindRunning(AUniqueID);
if Result <> nil then
Exit;
end;
Result := CreateFunc(AContext, AFuncURL);
try
InternalRunFunc(Result, AParams, AUniqueID, BeforeRunFunc, Modal);
if Result.Terminated then
FNeedFreeFuncs.Add(Result);
except
Result.Free;
raise;
end;
end;
procedure TFuncManager.InternalFuncTerminateNotify(Func: TFunc; Force: Boolean);
var
I: Integer;
begin
if Force then FNotifiedFuncs.Add(Func);
try
DoFuncTerminate(Func);
FRunningFuncs.Remove(Func);
FNeedFreeFuncs.Add(Func);
for I := RunningFuncIDs.Count - 1 downto 0 do
if RunningFuncIDs.Objects[I] = Func then
RunningFuncIDs.Delete(I);
except
if Force then
begin
FRunningFuncs.Remove(Func);
// 注意：RunningFuncIDs中有多个相同的TFunc实例
for I := RunningFuncIDs.Count - 1 downto 0 do
if RunningFuncIDs.Objects[I] = Func then
RunningFuncIDs.Delete(I);
// 注意：一定要放到最后，应为该行有可能产生异常。
FNeedFreeFuncs.Add(Func);
end;
raise;
end;
end;
procedure TFuncManager.FuncTerminate(Func: TFunc);
begin
DisableFuncRecycle;
try
InternalFuncTerminateNotify(Func, False);
finally
EnableFuncRecycle;
end;
end;
procedure TFuncManager.FreeFunc(Func: TFunc);
var
P: TContext;
F: TFlowControl;
begin
F := nil;
try
try
P := Func.Context.Parent;
if (P <> nil) and (P.Owner is TFlowControl) then
F := TFlowControl(P.Owner);
finally
Func.Free;
end;
finally
if F <> nil then F.Free;
end;
end;
procedure TFuncManager.RecycleFuncs;
var
C: TComponent;
I: Integer;
begin
while FNeedFreeFuncs.Count > 0 do
try
I := FNeedFreeFuncs.Count - 1;
C := FNeedFreeFuncs[I];
FNeedFreeFuncs.Delete(I);
FreeFunc(TFunc(C));
except
// 注意：这个错误不能被报出去
on E: object do
TSystemCore.SystemInterface.ShowException(E)
else
raise;
end;
end;
procedure TFuncManager.FuncRecycleOnTimer(Sender: TObject);
begin
FFuncRecycleTimer.Enabled := False;
RecycleFuncs;
end;
procedure TFuncManager.DisableFuncRecycle;
begin
Inc(FFuncRecycleDisableCount);
end;
procedure TFuncManager.EnableFuncRecycle;
begin
Dec(FFuncRecycleDisableCount);
if FFuncRecycleDisableCount = 0 then
begin
FFuncRecycleTimer.Enabled := False;
FFuncRecycleTimer.Enabled := True;
end;
end;
{function TFuncManager.FindOperatorPositionByDeptID(const ADeptID: string;
AOperator: TOperator): TOperatorPosition;
var
I: Integer;
lPosition: TOperatorPosition;
begin
for I := 0 to AOperator.PositionCount - 1 do
begin
lPosition := AOperator.Positions[I];
if SysUtils.SameText(lPosition.PositionMember.Parent.ID, ADeptID) then
begin
Result := lPosition;
Exit;
end;
end;
Result := nil;
end;}
procedure TFuncManager.DoFuncRun(Func: TFunc; Modal: Boolean);
begin
if OnFuncRun <> nil then
OnFuncRun(Self, Func, Modal);
end;
procedure TFuncManager.DoFuncActivate(Func: TFunc);
begin
if OnFuncActivate <> nil then
OnFuncActivate(Self, Func)
else
if Func.MainForm <> nil then
Func.MainForm.Show;
end;
procedure TFuncManager.DoFuncTerminate(Func: TFunc);
begin
if OnFuncTerminate <> nil then
OnFuncTerminate(Self, Func)
end;
function TFuncManager.GetRunningFuncCount: Integer;
begin
Result := FRunningFuncs.Count;
end;
function TFuncManager.GetRunningFunc(Index: Integer): TFunc;
begin
Result := FRunningFuncs[Index] as TFunc;
end;
function TFuncManager.GetFuncURLByTask(ATask: TTask): string;
var
lProc: TProc;
lProcUnit: TProcUnit;
begin
if ATask.FuncURL <> '' then
Result := ATask.FuncURL
else if ATask.ProcUnitID <> '' then
begin
lProc := TSystemCore.GetBizObject(BizSys.GlobalContext, ATask.ProcURL) as TProc;
lProcUnit := lProc.GetUnit(ATask.ProcUnitID);
Result := TProcActivity(lProcUnit).FuncURL.URL;
end
else
Result := '';
end;
function TFuncManager.FindTaskRunPosition(AContext: TContext; T: TTask;
ATaskMessage: TTaskMessage): TOperatorPosition;
var
lOperator: TOperator;
lPosFound: Boolean;
lPositions: array of TOperatorPosition;
begin
lOperator := AContext.GetParentContext(BizSys.IL_PERSON).Owner as TOperator;
lPositions := []; // 干掉警告
// 取人员成员匹配的
lPosFound := lOperator.FindPosition(ATaskMessage.ReceiverDeptID,
ATaskMessage.ReceiverPositionID, ATaskMessage.ReceiverID, lPositions);
// 取岗位成员匹配的环境
if not lPosFound and (ATaskMessage.ReceiverPositionID <> '') and
(ATaskMessage.ReceiverDeptID <> '') then
lPosFound := lOperator.FindPosition(ATaskMessage.ReceiverDeptID, ATaskMessage.ReceiverPositionID, '', lPositions);
// 取岗位匹配的环境
if not lPosFound and (ATaskMessage.ReceiverPositionID <> '') and
(ATaskMessage.ReceiverDeptID <> '') then
lPosFound := lOperator.FindPosition('', ATaskMessage.ReceiverPositionID, '', lPositions);
// 取部门匹配的环境
if not lPosFound and (ATaskMessage.ReceiverDeptID <> '') then
lPosFound := lOperator.FindPosition(ATaskMessage.ReceiverDeptID, '', '', lPositions);
if lPosFound then
Result := lPositions[0]
else
Result := nil;
end;
procedure TFuncManager.ActivateFunc(Func: TFunc);
begin
DoFuncActivate(Func);
end;
procedure TFuncManager.ActivateTask(Task: TTask);
var
lFunc: TFunc;
begin
lFunc := FindRunning(GetTaskUniqueID(Task));
ActivateFunc(lFunc);
end;
static function TFuncManager.GetFuncUniqueID(AContext: TContext; const AFuncURL, AParams: string): string;
var
Dept, Pos, Opr: string;
begin
GetContextOperator(AContext, Dept, Pos, Opr);
Result := GetFuncUniqueID(AFuncURL, AParams, Dept, Pos, Opr);
end;
static function TFuncManager.GetFuncUniqueID(const AFuncURL, AParams, ADeptID, APositionID, APersonID: string): string;
begin
Result := AFuncURL + '||' + AParams + '||' + ADeptID + '||' + APositionID + '||' + APersonID;
end;
function TFuncManager.FindRunning(const AUniqueID: string): TFunc;
var
I: Integer;
begin
I := -1;
if RunningFuncIDs.Find(AUniqueID, I) then
Result := TFunc(RunningFuncIDs.Objects[I])
else
Result := nil;
end;
function TFuncManager.IsDefaultFunc(const AFuncURL: string): Boolean;
begin
Result := OrgSys.DefaultFuncs.ExistFunc(AFuncURL);
end;
procedure GetContextOperator(AContext: TContext; out Dept, Pos, Opr: string);
var
C: TContext;
lPos: TOperatorPosition;
begin
C := AContext.FindParentContext(BizSys.IL_POSITION);
if C = nil then
begin
C := AContext.GetParentContext(BizSys.IL_PERSON);
Dept := '';
Pos := '';
Opr := (C.Owner as TOperator).ID;
end
else
begin
lPos := C.Owner as TOperatorPosition;
Dept := lPos.PositionMember.Parent.ID;
Pos := lPos.PositionMember.ID;
Opr := lPos.PersonMember.ID;
end;
end;
function TFuncManager.RunFunc(AContext: TContext; const AUniqueID, AFuncURL, AParams: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc;
var
UID: string;
lFuncItem: TOperatorFuncItem;
begin
UID := AUniqueID;
if UID = '' then
UID := GetFuncUniqueID(AContext, AFuncURL, AParams);
Result := FindRunning(UID);
if Result <> nil then
begin
ActivateFunc(Result);
Exit;
end;
lFuncItem := TContextUtils.GetOperator(AContext).FuncItems.Find(AFuncURL);
if lFuncItem = nil then
Result := InternalRunFunc(AContext, AFuncURL, AParams, UID, BeforeRunFunc, Modal)
else
Result := RunFunc(AContext, lFuncItem, AParams, UID, BeforeRunFunc, Modal);
end;
procedure TFuncManager.RunFunc(AContext: TContext; const AUniqueID, AFuncURL, AParams: string; UseUI: Boolean; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean);
var
lFunc: TFunc;
begin
lFunc := FindRunning(AUniqueID);
if lFunc <> nil then
begin
ActivateFunc(lFunc);
Exit;
end;
if FOnRunFunc <> nil then
begin
FOnRunFunc(AContext, AUniqueID, AFuncURL, AParams, UseUI, BeforeRunFunc, Modal);
Exit;
end;
RunFunc(AContext, AUniqueID, AFuncURL, AParams, BeforeRunFunc, Modal);
end;
function TFuncManager.RunFunc(AContext: TContext; AFuncItem: TOperatorFuncItem; const AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc;
const
ErrMsg = '当前操作者不具备运行该功能的权限，请向管理员询问';
var
S: string;
lPosition: TOperatorPosition;
lProc: TProc;
lEntryID: string;
lFlowControl: TFlowControl;
lOrgURL: TOrgURL;
begin
S := AUniqueID;
if S = '' then
S := GetFuncUniqueID(AContext, AFuncItem.FuncURL.URL, AParams);
Result := FindRunning(S);
if Result <> nil then
begin
ActivateFunc(Result);
Exit;
end;
if not AFuncItem.IsProcEntry then
Result := InternalRunFunc(AContext, AFuncItem.FuncURL.URL, AParams, S, BeforeRunFunc, Modal)
else
begin
lPosition := TContextUtils.GetOperatorPosition(AContext);
lProc := TSystemCore.GetBizObject(BizSys.GlobalContext, AFuncItem.ProcURL.URL) as TProc;
lFlowControl := TFlowControl.Create(AContext);
try
lEntryID := lProc.GetEntryUnitByFuncURL(AFuncItem.FuncURL).ID;
// 不能使用AFuncItem的OrgURL,因为它不一定是人员成员
lOrgURL := TOrgURL.Create(lPosition.PositionMember.Parent.ID,
lPosition.PositionMember.ID, lPosition.PersonMember.ID);
try
lFlowControl.ExecuteFlow(AFuncItem.ProcURL, lEntryID, lOrgURL);
finally
lOrgURL.Free;
end;
Result := CreateFunc(lFlowControl.Context, AFuncItem.FuncURL.URL);
try
lFlowControl.Func := Result;
InternalRunFunc(Result, AParams, S, BeforeRunFunc, Modal);
except
Result.Free;
raise;
end;
except
lFlowControl.Free;
raise;
end;
end;
end;
procedure TFuncManager.RunFunc(AFunc: TFunc; const AParams, AUniqueID: string);
begin
InternalRunFunc(AFunc, AParams, AUniqueID, nil, False);
end;
procedure TFuncManager.RunFunc(AFunc: TFunc; const AParams: string; AUniqueIDs: TStrings);
begin
InternalRunFunc(AFunc, AParams, AUniqueIDs, nil, False);
end;
{function TFuncManager.RunFunc(const AFuncURL, ADeptID, APositionID, APersonID, AParams: string): TFunc;
const
cErrMsg = '当前岗位和用户不具备运行此功能的权限，请向管理员至询。';
var
lFuncItem: TOperatorFuncItem;
begin
lFuncItem := FindFuncItem(AFuncURL, ADeptID, APositionID, APersonID);
if lFuncItem <> nil then
Result := RunFunc(lFuncItem, AParams, '')
else
raise Exception.Create(cErrMsg);
end;}
static function TFuncManager.GetTaskUniqueID(ATask: TTask): string;
begin
Result := ATask.GUID;
end;
function TFuncManager.IsTaskRunning(ATask: TTask): Boolean;
var
I: Integer;
begin
I := -1;
Result := RunningFuncIDs.Find(GetTaskUniqueID(ATask), I);
end;
function TFuncManager.RunTasks(AContext: TContext; ATasks: TList; ATaskMessages: TList;
AutoDetectContext: Boolean): TFunc;
var
lTask: TTask;
lTaskMsg: TTaskMessage;
lPosition: TOperatorPosition;
lExecutor: TOrgURL;
begin
lTask := ATasks[0] as TTask;
lTaskMsg := ATaskMessages[0] as TTaskMessage;
if AutoDetectContext then
begin
lPosition := FindTaskRunPosition(AContext, lTask, lTaskMsg);
if lPosition = nil then
lPosition := (AContext.FindParentContext(BizSys.IL_POSITION).Owner as TOperator).Positions[0];
end
else
begin
Assert(AContext.FindParentContext(BizSys.IL_POSITION) <> nil, '');
lPosition := AContext.FindParentContext(BizSys.IL_POSITION).Owner as TOperatorPosition;
end;
lExecutor := TOrgURL.Create(lPosition.PositionMember.Parent.ID,
lPosition.PositionMember.ID, lPosition.PersonMember.ID);
try
Result := RunTasks(lPosition.Context, ATasks, ATaskMessages, lExecutor);
finally
lExecutor.Free;
end;
end;
function TFuncManager.RunTasks(AContext: TContext; ATasks: TList; ATaskMessages: TList;
AExecutor: TOrgURL): TFunc;
var
I: Integer;
lTask: TTask;
lFuncURL: string;
lUIDs: TStringList;
lFlowControl: TFlowControl;
begin
lTask := ATasks[0] as TTask;
lFuncURL := GetFuncURLByTask(lTask);
Assert(lFuncURL <> '', '');
lUIDs := TStringList.Create;
try
for I := 0 to ATasks.Count - 1 do
lUIDs.Add(GetTaskUniqueID(ATasks[I] as TTask));
lFlowControl := TFlowControl.Create(AContext);
try
lFlowControl.ExecuteTask(ATasks, AExecutor);
Result := CreateFunc(lFlowControl.Context, lFuncURL);
try
lFlowControl.Func := Result;
InternalRunFunc(Result, '', lUIDs, nil, False);
except
Result.Free;
raise;
end;
except
lFlowControl.Free;
raise;
end;
finally
lUIDs.Free;
end;
end;
function TFuncManager.RunTasks(AContext: TContext; ATasks: TList): TFunc;
var
I: Integer;
lTask: TTask;
lTaskMsg: TTaskMessage;
lContext: TContext;
lOperator: TOperator;
lPosFound: Boolean;
lPosition: TOperatorPosition;
lPositions: array of TOperatorPosition;
begin
lTask := ATasks[0] as TTask;
lPositions := []; // 干掉警告
lContext := AContext.FindParentContext(BizSys.IL_PERSON);
lOperator := lContext.Owner as TOperator; //TSystemCore.UserManager.CurrentUser;
lPosFound := False;
for I := 0 to lTask.TaskMessages.Count - 1 do
begin
lTaskMsg := lTask.TaskMessages[I];
// 取人员匹配的
if (lTaskMsg.ReceiverID <> '') then
lPosFound := lOperator.FindPosition(lTaskMsg.ReceiverDeptID, lTaskMsg.ReceiverPositionID, lTaskMsg.ReceiverID, lPositions);
// 取岗位匹配的环境
if not lPosFound and (lTaskMsg.ReceiverPositionID <> '') then
if lTaskMsg.ReceiverDeptID <> '' then
lPosFound := lOperator.FindPosition(lTaskMsg.ReceiverDeptID, lTaskMsg.ReceiverPositionID, '', lPositions)
else
lPosFound := lOperator.FindPosition('', lTaskMsg.ReceiverPositionID, '', lPositions);
// 取部门匹配的环境
if not lPosFound and (lTaskMsg.ReceiverDeptID <> '') then
lPosFound := lOperator.FindPosition(lTaskMsg.ReceiverDeptID, '', '', lPositions);
if lPosFound then
Break;
end;
if lPosFound then
lPosition := lPositions[0]
else
lPosition := lOperator.Positions[0];
Result := RunTasks(lPosition, ATasks);
end;
function TFuncManager.RunTasks(APosition: TOperatorPosition; ATasks: TList): TFunc;
var
lOrgURL: TOrgURL;
begin
lOrgURL := TOrgURL.Create(APosition.PositionMember.Parent.ID,
APosition.PositionMember.ID, APosition.PersonMember.ID);
try
Result := RunTasks(APosition.Context, ATasks, lOrgURL);
finally
lOrgURL.Free;
end;
end;
function TFuncManager.RunTasks(AContext: TContext; ATasks: TList;
AExecutor: TOrgURL): TFunc;
var
I: Integer;
lTask: TTask;
lFuncURL: string;
lUIDs: TStringList;
lFlowControl: TFlowControl;
begin
lTask := ATasks[0] as TTask;
lFuncURL := GetFuncURLByTask(lTask);
if lFuncURL = '' then
raise Exception.CreateFmt('找不到与任务''%s''对应的业务功能', [lTask.Subject]);
lUIDs := TStringList.Create;
try
for I := 0 to ATasks.Count - 1 do
lUIDs.Add(GetTaskUniqueID(ATasks[I] as TTask));
lFlowControl := TFlowControl.Create(AContext);
try
lFlowControl.ExecuteTask(ATasks, AExecutor);
Result := CreateFunc(lFlowControl.Context, lFuncURL);
try
lFlowControl.Func := Result;
InternalRunFunc(Result, '', lUIDs, nil, False);
except
Result.Free;
raise;
end;
except
lFlowControl.Free;
raise;
end;
finally
lUIDs.Free;
end;
end;
function TFuncManager.RunTask(AContext: TContext; ATask: TTask): TFunc;
var
lTasks: TList;
begin
lTasks := TList.Create;
try
lTasks.Add(ATask);
Result := RunTasks(AContext, lTasks);
finally
lTasks.Free;
end;
end;
function TFuncManager.RunTask(APosition: TOperatorPosition; ATask: TTask): TFunc;
var
lTasks: TList;
begin
lTasks := TList.Create;
try
lTasks.Add(ATask);
Result := RunTasks(APosition, lTasks);
finally
lTasks.Free;
end;
end;
static function TFuncManager.GetFuncDisplayText(Func: TFunc): string;
begin
try
Result := Func.DisplayName;
except
Result := '未知的功能';
end;
end;
function TFuncManager.TerminateFunc(Func: TFunc; Force: Boolean): Boolean;
const
ErrMsg01 = '%s并没有运行或者已经结束了';
ErrMsg02 = '结束 %s 的时候产生了错误。错误信息：%s 。你想要结束它吗?';
begin
if FRunningFuncs.IndexOf(Func) = -1 then
raise Exception.CreateFmt(ErrMsg01, [GetFuncDisplayText(Func)]);
DisableFuncRecycle;
try
try
if not Force and not Func.TerminateQuery then
begin
Result := False;
Exit;
end;
Func.Terminate;
except
on E: object do
begin
if FNotifiedFuncs.IndexOf(Func) = -1 then
begin
if not Force and not JSDialogs.ConfirmBox(SysUtils.Format(ErrMsg02, [
GetFuncDisplayText(Func),
TSystemCore.SystemInterface.GetExceptionText(E)]),
'', 2) then
begin
Result := False;
Exit;
end;
InternalFuncTerminateNotify(Func, True);
end;
if Force then raise;
end;
end;
finally
FNotifiedFuncs.Remove(Func);
EnableFuncRecycle;
end;
Result := True;
end;
function TFuncManager.TerminateFuncs(Funcs: TList; Force: Boolean): Boolean;
const
ErrMsg01 = '结束%s的时候出现错误：%s，该功能已经被强制结束。';
ErrMsg02 = '结束%s的时候出现错误：%s，该功能已经被强制结束，是否继续？';
var
I: Integer;
lFunc: TFunc;
begin
DisableFuncRecycle;
try
for I := 0 to Funcs.Count - 1 do
begin
lFunc := Funcs[I] as TFunc;
if FRunningFuncs.IndexOf(lFunc) = -1 then
Continue;
try
if not TerminateFunc(lFunc, Force) then
begin
Result := False;
Exit;
end;
except
on E: object do
begin
if Force then
JSDialogs.ShowError(SysUtils.Format(ErrMsg01, [
GetFuncDisplayText(lFunc),
TSystemCore.SystemInterface.GetExceptionText(E)]), '结束功能')
else
if not JSDialogs.ConfirmBox(SysUtils.Format(ErrMsg02, [
GetFuncDisplayText(lFunc),
TSystemCore.SystemInterface.GetExceptionText(E)]),
'', 2) then
begin
Result := False;
Exit;
end;
end;
end;
end;
finally
EnableFuncRecycle;
end;
Result := True;
end;
function TFuncManager.TerminateAllFuncs(Force: Boolean): Boolean;
var
lFuncs: TList;
begin
lFuncs := TList.Create;
try
lFuncs.Assign(FRunningFuncs, TListAssignOp.laCopy, nil);
Result := TerminateFuncs(lFuncs, Force);
finally
lFuncs.Free;
end;
end;
procedure TFuncManager.GetRunningFuncs(Funcs: TList; Context: TContext);
var
I: Integer;
lFunc: TFunc;
begin
if Context = nil then
Funcs.Assign(FRunningFuncs, TListAssignOp.laCopy, nil)
else
for I := 0 to FRunningFuncs.Count - 1 do
try
lFunc := FRunningFuncs[I] as TFunc;
if (lFunc.Context.FindParentContext(Context.IsolationLevel) = Context) then
Funcs.Add(lFunc);
except
on E: object do
TSystemCore.SystemInterface.ShowException(E)
else
raise;
end;
end;
{ TSystemInterfaceManager }
constructor TSystemInterfaceManager.Create;
begin
inherited;
FLoaded := TStringList.Create;
FLoaded.Duplicates := TDuplicates.dupError;
FLoaded.Sorted := True;
end;
destructor TSystemInterfaceManager.Destroy;
begin
Clear;
FLoaded.Free;
inherited;
end;
procedure TSystemInterfaceManager.Clear;
var
I: Integer;
begin
for I := 0 to FLoaded.Count - 1 do
FLoaded.Objects[I].Free;
FLoaded.Clear;
end;
function TSystemInterfaceManager.CreateNew(const URL: string): TAbstractSystemInterface;
const
SSystemInterface = '\SystemInterface.Library';
var
lObj: TBizObject;
begin
lObj := TSystemCore.CreateBizObject(BizSys.GlobalContext,
TSystemCore.UITheme.InternalFixURL(URL, SSystemInterface));
try
Result := lObj as TAbstractSystemInterface;
FLoaded.AddObject(URL, lObj);
except
lObj.Free;
raise;
end;
end;
function TSystemInterfaceManager.Find(const URL: string): TAbstractSystemInterface;
var
I: Integer;
begin
Assert((URL <> nil) and (URL <> ''), 'URL为空');
I := -1;
if FLoaded.Find(URL, I) then
Result := FLoaded.Objects[I] as TAbstractSystemInterface
else
Result := nil;
end;
function TSystemInterfaceManager.Get(const URL: string): TAbstractSystemInterface;
begin
Result := Find(URL);
if Result = nil then
Result := CreateNew(URL);
end;
{ TDotNetObjectList }
function TDotNetObjectList.GetItem(Index: Integer): object;
begin
if (0 > Index) or (Index >= FCount) then
raise Exception.Create('Index out of bound');
Result := FArray[Index];
end;
procedure TDotNetObjectList.SetItem(Index: Integer; O: object);
begin
if (0 > Index) or (Index >= FCount) then
raise Exception.Create('Index out of bound');
FArray[Index] := O;
end;
procedure TDotNetObjectList.SetCount(C: Integer);
var
I: Integer;
begin
CheckArrayLength(C);
for I := FCount - 1 downto C do
FArray[I] := nil;
FCount := C;
end;
procedure TDotNetObjectList.CheckArrayLength(L: Integer);
begin
if (FArray = nil) or (Length(FArray) < L) then
begin
L := (L + 31) and not 31;
SetLength(FArray, L);
end;
end;
procedure TDotNetObjectList.Add(O: object);
var
I: Integer;
begin
I := FCount;
Count := I + 1;
FArray[I] := O;
end;
procedure TDotNetObjectList.Add(List: TDotNetObjectList);
var
C: Integer;
begin
C := Count;
Count := Count + List.Count;
System.Array.Copy(List.FArray, 0, FArray, C, List.Count);
end;
procedure TDotNetObjectList.Delete(Index, ACount: Integer);
var
I: Integer;
begin
for I := Index to FCount - ACount - 1 do
FArray[I] := FArray[I + ACount];
Count := FCount - ACount;
end;
procedure TDotNetObjectList.Delete(Index: Integer);
begin
Delete(Index, 1);
end;
procedure TDotNetObjectList.Insert(Index: Integer; O: array of object);
var
I, C: Integer;
begin
C := Length(O);
Count := FCount + C;
for I := FCount - 1 downto Index + C do
FArray[I] := FArray[I - C];
for I := 0 to C - 1 do
FArray[Index + I] := O[I];
end;
procedure TDotNetObjectList.Clear;
begin
Count := 0;
end;
function TDotNetObjectList.IndexOf(O: object): Integer;
var
I: Integer;
begin
for I := 0 to Count - 1 do
if FArray[I] = O then
begin
Result := I;
Exit;
end;
Result := -1;
end;
function TDotNetObjectList.Remove(O: object): Integer;
begin
Result := IndexOf(O);
if Result >= 0 then
Delete(Result);
end;
{ TFlowManager }
procedure TFlowManager.DoEvent(FEvent: TFlowCommandNotifyEvent; ACommand: TFlowCommand);
begin
if Assigned(FEvent) then
FEvent(Self, ACommand);
end;
procedure TFlowManager.doOnCreateFlowTasks(ACommand: TFlowCommand);
begin
doEvent(FOnCreateFlowTasks, ACommand);
end;
procedure TFlowManager.doAfterFlowCommand(ACommand: TFlowCommand);
begin
doEvent(FAfterFlowCommand, ACommand);
end;
procedure TFlowManager.doBeforeFLowCommand(ACommand: TFlowCommand);
begin
doEvent(FBeforeFlowCommand, ACommand);
end;
procedure TFlowManager.doOnPrepareTasksCommand(ACommand: TFlowCommand);
begin
doEvent(FOnPrepareTasksCommand, ACommand);
end;
procedure TFlowManager.doOnPrepareFlowsCommand(ACommand: TFlowCommand);
begin
doEvent(FOnPrepareFlowsCommand, ACommand);
end;
procedure TFlowManager.doOnPrepareFlowTasksCommand(ACommand: TFlowCommand);
begin
doEvent(FOnPrepareFlowTasksCommand, ACommand);
end;
{ TBizMessages }
static procedure TBizMessages.Notify(AContext: TContext; const AMsg: string; LogonContext: TContext);
var
lMessage: TLogonMessage;
begin
lMessage := TLogonMessage.Create(AMsg, LogonContext);
try
AContext.SendMessage(lMessage);
finally
lMessage.Free;
end;
end;
static function TBizMessages.LogonMessage: string;
begin
Result := 'System.Logon';
end;
static function TBizMessages.LogoffMessage: string;
begin
Result := 'System.Logoff';
end;
//add by wdx
constructor TLogonMessage.Create(const AMsg: string; AContext: TContext);
begin
inherited Create(AMsg);
FContext := AContext;
end;
{ TBizSystemDefineList }
constructor TBizSystemDefineList.Create;
begin
Init;
end;
procedure TBizSystemDefineList.Init;
const
cSQL = 'SELECT * FROM TBIZSYSTEMDEFINE ORDER BY FSEQUENCE';
var
lQuery: TQuery;
begin
lQuery := TQuery.Create(nil);
try
lQuery.Connection := ExtUtils.SystemConnection;
lQuery.CommandText := cSQL;
lQuery.Open;
while not lQuery.Eof do
begin
Add(CreateBizSystemInfo(lQuery));
lQuery.Next;
end;
finally
lQuery.Free;
end;
end;
function TBizSystemDefineList.CreateBizSystemInfo(ADataSet: TDataSet): TBizSystemDefine;
begin
Result := TBizSystemDefine.Create;
Result.ID := ADataSet.FieldByName('FID').AsString;
Result.DisplayName := ADataSet.FieldByName('FDisplayName').AsString;
Result.Path := ADataSet.FieldByName('FPath').AsString;
==这行错====》Result.Visible := ADataSet.FieldByName
('FVisible').IsNull or ADataSet.FieldByName ('FVisible').AsBoolean;
end;
static function TBizSystemDefineList.Count: Integer;
begin
Result := TDotNetObjectList(FBizSystemInfos).Count;
end;
static function TBizSystemDefineList.Items(Index: Integer): TBizSystemDefine;
begin
Result := TDotNetObjectList(FBizSystemInfos).Items[Index] as TBizSystemDefine;
end;
end. |
楼主
发表于 2007-8-20 18:10:36
