楼主，3109版本没有融进去，我们这边正在准备一个最新的版本，等这个版本出来后可以解决此问题。（你们的版本先升级到3109，对于这个问题的实现，我下面贴一个完整的修改方法）
1、业务模型\系统空间\系统运行库\系统核心库
增加函数
procedure TFuncManager.SetCurrentTaskState(AFlowControl: TFlowControl; AExecutor: TOrgURL);
var
I: Integer;
begin
for I := 0 to AFlowControl.CurrentTask.TaskMessages.Count -1 do
with AFlowControl.CurrentTask.TaskMessages[I] do
if SysUtils.SameText(ReceiverDeptID, AExecutor.DeptID)
and SysUtils.SameText(ReceiverPositionID, AExecutor.PositionID)
and SysUtils.SameText(ReceiverID, AExecutor.PersonID) then
begin
State := TTaskMessageState.tmsReceived;
AFlowControl.CurrentTask.SaveToDB;
Break;
end;
end;
调用
function TFuncManager.RunFunc(AContext: TContext; AFuncItem: TOperatorFuncItem; const AParams, AUniqueID: string; BeforeRunFunc: TFuncNotifyEvent; Modal: Boolean): TFunc;
const
ErrMsg = '当前操作者不具备运行该功能的权限，请向管理员询问';
var
S: string;
lRealFuncURL: TBizURL;
lPosition: TOperatorPosition;
lProcURL: TBizURL;
lProc: TProc;
lEntryID: string;
lFlowControl: TFlowControl;
lOrgURL: TOrgURL;
I: Integer;
begin
// 这里运行支持扩展空间的机制
// 流程使用扩展空间的规则：流程需要扩展，并且入口功能也需要扩展
lRealFuncURL := BizSys.ObjectInfoFromURL(BizSys.BizService.GetFixURL(AFuncItem.FuncURL.URL)).BizURL;
S := AUniqueID;
if S = '' then
S := GetFuncUniqueID(AContext, lRealFuncURL.URL, AParams);
Result := FindRunning(S);
if Result <> nil then
begin
ActivateFunc(Result);
Exit;
end;
if not AFuncItem.IsProcEntry then
Result := InternalRunFunc(AContext, lRealFuncURL.URL, AParams, S, BeforeRunFunc, Modal)
else
begin
// 流程这里采取了扩展空间的机制
lPosition := TContextUtils.GetOperatorPosition(AContext);
lProcURL := TBizURL.Create;
try
lProcURL.URL := BizSys.BizService.GetFixURL(AFuncItem.ProcURL.URL);
lProc := TSystemCore.GetBizObjectEx(AContext, lProcURL.URL, '') as TProc;
lFlowControl := TFlowControl.Create(AContext);
try
lEntryID := lProc.GetEntryUnitByFuncURL(lRealFuncURL).ID;
// 不能使用AFuncItem的OrgURL,因为它不一定是人员成员
lOrgURL := TOrgURL.Create(lPosition.PositionMember.Parent.ID,
lPosition.PositionMember.ID, lPosition.PersonMember.ID);
try
lFlowControl.ExecuteFlow(lProcURL, lEntryID, lOrgURL);
SetCurrentTaskState(lFlowControl, lOrgURL); finally
lOrgURL.Free;
end;
Result := CreateFunc(lFlowControl.Context, lRealFuncURL.URL);
try
lFlowControl.Func := Result;
InternalRunFunc(Result, AParams, S, BeforeRunFunc, Modal);
except
Result.Free;
raise;
end;
except
lFlowControl.Free;
raise;
end;
finally
lProcURL.Free;
end;
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;
lOrgURL: TOrgURL;
lPosition: TOperatorPosition;
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);
lPosition := TContextUtils.GetOperatorPosition(AContext);
try
// 不能使用AFuncItem的OrgURL,因为它不一定是人员成员
lOrgURL := TOrgURL.Create(lPosition.PositionMember.Parent.ID,
lPosition.PositionMember.ID, lPosition.PersonMember.ID);
SetCurrentTaskState(lFlowControl, lOrgURL);
finally
lOrgURL.Free;
end;
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;
AExecutor: TOrgURL): TFunc;
var
I: Integer;
lTask: TTask;
lFuncURL: string;
lUIDs: TStringList;
lFlowControl: TFlowControl;
lOrgURL: TOrgURL;
lPosition: TOperatorPosition;
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);
lPosition := TContextUtils.GetOperatorPosition(AContext);
try
// 不能使用AFuncItem的OrgURL,因为它不一定是人员成员
lOrgURL := TOrgURL.Create(lPosition.PositionMember.Parent.ID,
lPosition.PositionMember.ID, lPosition.PersonMember.ID);
SetCurrentTaskState(lFlowControl, lOrgURL);
finally
lOrgURL.Free;
end;
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;
2、业务模型\协同系统\任务\任务中心信息
增加函数
function GetPrevTask(ATask: TTask; AContext: TContext): TTaskArray;
var
lLoader: TTaskDBStorage;
lPrevTask: TTask;
lTasks: TTaskArray;
I, J, K: Integer;
begin
lLoader := TTaskDBStorage.Create;
lTasks := lLoader.Load('SELECT FGUID FROM TTASK WHERE FNEXTGUID = ' + SysUtils.QuotedStr(ATask.GUID) + ' OR FGUID=' +
SysUtils.QuotedStr(ATask.PrevGUID), nil);
Result := lTasks;
//if lTasks.Length = 0 then
//Business.Forms.jsDialogs.MsgBox(0, '找不到前项任务，不能取回!', '错误', 16);
lPrevTask := lTasks[0];
K := 0;
if SysUtils.SameText(lPrevTask.Kind, 'ftkActivity') then
begin
for I := 0 to lTasks.Length - 1 do
for J := 0 to lTasks[I].TaskMessages.Count - 1 do
if SysUtils.SameText(lTasks[I].TaskMessages[J].ReceiverID, TContextUtils.FindOperator(AContext).ID) then
begin
SetLength(Result, K + 1);
Result[K] := lTasks[I];
Inc(K);
continue;
end;
end;
if SysUtils.SameText(lPrevTask.Kind, 'ftkControl') then
begin
//Business.Forms.jsDialogs.MsgBox(0, '取回不支持控制环节，只能回退!', '错误', 16);
Result := [];
Exit;
end;
if SysUtils.SameText(lPrevTask.Kind, 'ftkSubProc') then
begin
//Business.Forms.jsDialogs.MsgBox(0, '不支持取回到子流程!', '错误', 16);
Result := [];
Exit;
end;
end;
function FetchBack1(AFlowToTask, Task: TTask; AContext: TContext) : Boolean;
var
lToTask, lPrevTask: TTask;
lPrevTasks: TTaskArray;
lToTaskMessage: TTaskMessage;
I, J: Integer;
lLoader: TTaskDBStorage;
lGUIDs: Array of String;
lTasks: TTaskArray;
lBizURL: TBizURL;
lTypeInfo: TCMTaskTypeInfo;
begin
Result := False;
lToTask := AFlowToTask;
lLoader := TTaskDBStorage.Create;
if Assigned(lToTask) then
begin
if not Task.IsFlowTask then
begin
lToTask := TTask.Create;
lPrevTask := Task;
lTypeInfo := TTaskDefineInfo.Instance(AContext).FindTaskTypeInfo(lPrevTask.TaskType);
lToTask.New(lTypeInfo);
lTasks := []; // 去除警告
SetLength(lTasks, 1);
lTasks := lLoader.Load([Task.GUID]);
end
else
begin
lGUIDs := []; // 去除警告
setLength(lGUIDs, 1);
lGUIDs[0] := Task.PrevGUID;//找前驱任务，以便恢复任务环境
for J := 0 to Task.TaskMessages.Count - 1 do
if Task.TaskMessages[J].State <> TTaskMessageState.tmsSend then
begin
//Business.Forms.jsDialogs.MsgBox(0, '有关任务['+ Task.Subject +']已经被“' + Task.TaskMessages[J].FReceiverName
// + '[' + Task.TaskMessages[J].FReceiverID + ']”处理，不能取回!', '错误', 16);
Exit;
end;
lPrevTasks := GetPrevTask(Task, AContext);
lTasks := lLoader.Load(lGUIDs);
if Length(lTasks)<1 then
begin
//Business.Forms.jsDialogs.MsgBox(0, '不能找到前项任务,不能取回！!', '错误', 16);
Exit;
end;
lPrevTask := lTasks[0];
if not (SysUtils.SameText(lPrevTask.Kind, 'ftkActivity') or SysUtils.SameText(lPrevTask.Kind, 'ftkReturn')) then
begin
//Business.Forms.jsDialogs.MsgBox(0, '前面环节不是活动环节，不能取回!', '错误', 16);
Exit;
end;
setLength(lTasks, 0);
//找兄弟任务以便全部撤消
lTasks := lLoader.Load('select FGUID from TTask where TTask.FPrevGUID = ' + SysUtils.QuotedStr(lPrevTask.GUID), nil);
for I := 0 to lTasks.Length - 1 do
if lTasks[I].State <> TTaskState.tsStarted then
begin
//Business.Forms.jsDialogs.MsgBox(0, '有关任务['+ lTasks[I].Subject +']已经被人处理，不能取回!', '错误', 16);
Exit;
end;
end;
end;
Result := True;
end;
function GetTaskCanFetchBack1(AContext: TContext; T: TTask): Boolean;
var
lPersonMembURLs: TStringList;
lLoader: TTaskDBStorage;
lTask: TTask;
lTasks: TTaskArray;
begin
lPersonMembURLs := TStringList.Create;
try
TContextUtils.GetPersonMemberURLs(AContext, lPersonMembURLs, False);
Result := lPersonMembURLs.IndexOf('Org:' + T.SenderOrgURL) <> -1;
finally
lPersonMembURLs.Free;
end;
if not Result then Exit; //通知任务（取到多条任务消息）回收失败暂不支持回收。SMP 20060930
if (not T.IsFlowTask) or SysUtils.SameText(T.Kind, 'ftkNotify') then
{由于任务同步问题暂时不能回收非流程任务，需求已经提给老唐，修改后，将False换成注释中的代码即可}
Result := false //T.State in SUnProcessTaskStates
else
begin
Result := (T.State = TTaskState.tsStarted) and not ((T.PrevGUID = '-1')or(T.PrevGUID = ''));
if Result then
begin
lLoader := TTaskDBStorage.Create;
lTasks := lLoader.Load([T.GUID]);
if lTasks.Length > 0 then
Result := SysUtils.SameText(lTasks[0].Kind, 'ftkActivity') OR SysUtils.SameText(lTasks[0].Kind, 'ftkReturn');
end;
end
end;
调用
procedure TTASKCENTERINFO.UpdateTaskState;
begin
// TODO: 需要做效率优化
// FTaskCanProcess := FTask <> nil;
FTaskCanProcess := (FTask <> nil) and TTaskServices.GetTaskCanRun(Context, FTask);
FTaskCanFlowOut := FTaskCanProcess;
// FTaskCanBatchProcess := (FTask <> nil);
FTaskCanBatchProcess := FTaskCanProcess and TTaskServices.GetTaskCanBatchRun(Context, FTask);
FTaskCanOpen := (FTask <> nil) and (FTask.FuncURL <> '') and
BizSys.BizSystem.URLExists(FTask.FuncURL) and
(Func.GetFuncSummaryDocURL(FTask.FuncURL) <> '');
//FTaskCanFlowOut := FTaskCanProcess and (not FTask.IsFlowTask) and
//TTaskServices.GetTaskCanFlowOut(Context, FTask);
// FTaskCanFinish := FTask <> nil;
FTaskCanFinish := (FTask <> nil) and (not FTask.IsFlowTask) and
(FTask.State in TTask.CanProcessTaskStates) and
(Length(TTaskServices.FindCanRunTaskMessages(Context, FTask)) > 0);;
[B] FTaskCanFetchBack := (FTask <> nil)
and GetTaskCanFetchBack1(Context, FTask)
and FetchBack1(FTask,Task, Context) ;//(TTaskServices.GetTaskCanFetchBack(Context, FTask));
FTaskCanDelete := CanTaskDelete;[/B]
end;
按上面的方式，就可以实现对于A环节走到B环节，B环节只要进行了处理，然后A环节在已提交任务的 右键--回收 灰色了。 |
发表于 2010-6-25 18:36:20
楼主