wsclasses.pas

Workflow Studio是一款专为商业进程管理（BPM）设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最

{ TWorkflowEngine }

procedure TWorkflowEngine.RunWorkflow(WorkIns: TWorkflowInstance);
begin
  WorkIns.Diagram.OnTerminate := WorkflowTerminated;
  WorkIns.Diagram.OnSaveState := WorkflowSaveState;

  {The line below is useless because the workflow is being run inside a thread.
   So, we cannot set the context here as it can be changed later.
   But we can set the context inside each procedure that uses the scriptengine, because
   the blocke execution is synchronized, so we can rely on global variables inside
   a procedure being executed by the worfklow thread. ALWAYS set the context before
   using the script engine}
  //WorkflowStudio.ScriptEngine.SetRuntimeContext(WorkIns);
  Case WorkIns.Status of
    wsRunning:
      WorkIns.Diagram.DoAction(daContinue);
    wsNotStarted:
      begin
        WorkIns.Status := wsRunning;
        WorkIns.Diagram.DoAction(daRun);
      end;
  end;
end;

procedure TWorkflowEngine.WorkflowSaveState(Sender: TObject);
var
  WI: TWorkflowInstance;
begin
  if Sender is TWorkflowDiagram then
  begin
    WI := TWorkflowDiagram(Sender).WorkflowInstance;
    WorkflowStudio.WorkflowManager.SaveWorkflowInstance(WI);
  end;
end;

procedure TWorkflowEngine.WorkflowTerminated(Sender: TLiveDiagram;
  ExitCode: integer);
var
  WI: TWorkflowInstance;
  ErrMsg: string;
  ShowError: boolean;
begin
  if Sender is TWorkflowDiagram then
  begin
    WI := TWorkflowDiagram(Sender).WorkflowInstance;

    {if the workflow is indeeed finished, then set started to false and save it to database}
    if ExitCode <> xWaitState_Termination then
    begin
      {Check if it was finished with an error}
      if ExitCode = xNormal_Termination then
        WI.Status := wsFinished
      else
        WI.Status := wsFinishedWithError;

      {Save status in workflow}
      WorkflowStudio.WorkflowManager.SaveWorkflowInstance(WI);

      {if workflow ended with an error...}
      if WI.Status = wsFinishedWithError then
      begin
        {Save a log or show an error message. For now, show an error}
        ErrMsg := Format(_str(SWorkInsExecutionError), [WI.Diagram.RunErrorMsg]);

        if WI.Diagram.ErrorNode <> nil then
        begin
          ErrMsg := Format(_str(SWorkInsExecutionError2),
            [ErrMsg, WI.Diagram.ErrorNode.ClassName, WI.Diagram.ErrorNode.Name,
             WI.Diagram.ErrorNode.Strings.Text]);
        end;

        ShowError := true;
        WorkflowStudio.WorkflowInstanceError(WI, ErrMsg, ShowError);
        if ShowError then
          ShowMessage(ErrMsg);
      end;
    end;

    WI.Free;
  end;
end;

{ TWorkflowScriptEngine }

function TWorkflowScriptEngine.CalculateExpression(Expr: string): Variant;
begin
end;

constructor TWorkflowScriptEngine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FExprDelim := '[,]';
end;

function TWorkflowScriptEngine.ExpressionToStr(Value: Variant): string;
begin
  if VarIsEmpty(Value) or VarIsNull(Value) or VarIsArray(Value) then
    result := ''
  else
    result := VarToStr(Value);
end;

function TWorkflowScriptEngine.ExtractExpression(AText, OpenDelim, CloseDelim: string;
  var i, j: Integer): string;
var
  c: integer;
  f1, f2: boolean;
begin
  result := '';
  j := i;
  f1 := true;
  f2 := true;
  c := 0;
  if (AText = '') or (j > Length(AText)) then
    Exit;

  dec(j);
  repeat
    inc(j);
    if f1 and f2 then
      if Copy(AText, j, Length(OpenDelim)) = OpenDelim then
      begin
        if c = 0 then
          i := j;
        inc(c);
      end
      else
      if Copy(AText, j, Length(CloseDelim)) = CloseDelim then
        dec(c);
    if f1 then
      if AText[j] = '"' then f2 := not f2;
    if f2 then
      if AText[j] = '''' then f1 := not f1;
  until (c = 0) or (j >= Length(AText));

  result := Copy(AText, i + Length(OpenDelim), j - i - Length(OpenDelim));
  if i <> j then
    Inc(j, Length(CloseDelim) - 1);
end;

procedure TWorkflowScriptEngine.SetDesignContext(
  ADiagram: TWorkflowDiagram);
begin
  FDiagram := ADiagram;
  FRunContext := scDesignDiagram;
  RunContextChanged;
end;

procedure TWorkflowScriptEngine.SetRuntimeContext(
  AWorkIns: TWorkflowInstance);
begin
  FWorkIns := AWorkIns;
  FRunContext := scRuntimeInstance;
  RunContextChanged;
end;

function TWorkflowScriptEngine.TranslateText(AText: string): string;
var
  i: integer;
  j: integer;
  OpenDelim, CloseDelim: string;
  s1: string;
  s2: string;
begin
  i := 1;
  OpenDelim := FExprDelim;
  CloseDelim := Copy(OpenDelim, Pos(',', OpenDelim) + 1, MaxInt);
  OpenDelim := Copy(OpenDelim, 1, Pos(',', OpenDelim) - 1);

  if Pos(OpenDelim, AText) <> 0 then
  begin
    repeat
      while (i < Length(AText)) and (Copy(AText, i, Length(OpenDelim)) <> OpenDelim) do Inc(i);

      s1 := ExtractExpression(AText, OpenDelim, CloseDelim, i, j);
      if i <> j then
      begin
        Delete(AText, i, j - i + 1);
        s2 := ExpressionToStr(CalculateExpression(s1));
        Insert(s2, AText, i);
        Inc(i, Length(s2));
        j := 0;
      end;
    until i = j;

  end;
  result := AText;
end;

{ TWorkflowUsers }

function TWorkflowUsers.Add: TWorkflowUser;
begin
  result := TWorkflowUser(inherited Add);
end;

function TWorkflowUsers.Add(AUserID: string; AUserName: string = ''; AEmail: string = ''): TWorkflowUser;
begin
  result := add;
  with result do
  begin
    UserId := AUserId;
    UserName := AUserName;
    EMail := AEmail;
  end;
end;

function TWorkflowUsers.FindById(AName: string): TWorkflowUser;
var
  c: integer;
begin
  result := nil;
  for c := 0 to Count - 1 do
    if CompareText(AName, Items[c].UserId) = 0 then
    begin
      result := Items[c];
      break
    end;
end;

function TWorkflowUsers.FindByName(AName: string): TWorkflowUser;
var
  c: integer;
begin
  result := nil;
  for c := 0 to Count - 1 do
    if CompareText(AName, Items[c].UserName) = 0 then
    begin
      result := Items[c];
      break
    end;
end;

function TWorkflowUsers.GetItem(Index: integer): TWorkflowUser;
begin
  result := TWorkflowUSer(inherited Items[Index]);
end;

{ TWorkflowGroup }

constructor TWorkflowGroup.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FUserIds := TStringList.Create;
end;

destructor TWorkflowGroup.Destroy;
begin
  FUserIds.Free;
  inherited;
end;

function TWorkflowGroup.GetGroupId: string;
begin
  if FGroupId > '' then
    result := FGroupId
  else
    result := FGroupName;
end;

function TWorkflowGroup.GetGroupName: string;
begin
  if FGroupName > '' then
    result := FGroupName
  else
    result := FGroupId;
end;

function TWorkflowGroup.GetUserManager: TWorkflowUserManager;
begin
  if (Collection is TWorkflowGroups) and (TWorkflowGroups(Collection).GetOwner is TWorkflowUserManager) then
    result := TWorkflowUserManager(TWorkflowGroups(Collection).GetOwner)
  else
    result := nil;
end;

procedure TWorkflowGroup.SetUserIds(const Value: TStrings);
begin
  FUserIds.Assign(Value);
end;

{ TWorkflowGroups }

function TWorkflowGroups.Add: TWorkflowGroup;
begin
  result := TWorkflowGroup(inherited Add);
end;

function TWorkflowGroups.Add(AGroupName: string): TWorkflowGroup;
begin
  result := Add;
  With result do
  begin
    GroupName := AGroupName;
    GroupID := AGroupName; 
  end;
end;

function TWorkflowGroups.Add(AGroupID, AGroupName: string): TWorkflowGroup;
begin
  result := Add;
  with result do
  begin
    GroupID := AGroupID;
    GroupName := AGroupName;
  end;
end;

function TWorkflowGroups.FindByID(AId: string): TWorkflowGroup;
var
  c: integer;
begin
  result := nil;
  for c := 0 to Count - 1 do
    if CompareText(AID, Items[c].GroupID) = 0 then
    begin
      result := Items[c];
      break
    end;
end;

function TWorkflowGroups.FindByName(AName: string): TWorkflowGroup;
var
  c: integer;
begin
  result := nil;
  for c := 0 to Count - 1 do
    if CompareText(AName, Items[c].GroupName) = 0 then
    begin
      result := Items[c];
      break
    end;
end;

function TWorkflowGroups.GetItem(Index: integer): TWorkflowGroup;
begin
  result := TWorkflowGroup(inherited Items[Index]);
end;

{ TWorkflowUser }

function TWorkflowUser.BelongsToGroup(AGroupId: string): boolean;
var
  AGroupIds: TStrings;
begin
  AGroupIds := TStringList.Create;
  try
    FillGroupIds(AGroupIds);
    result := (AGroupIds.IndexOf(AGroupId) >= 0);
  finally
    AGroupIds.Free;
  end;
end;

procedure TWorkflowUser.FillGroupIds(AGroupIds: TStrings);
var
  c: integer;
begin
  AGroupIds.Clear;
  for c := 0 to UserManager.Groups.Count - 1 do
    if UserManager.Groups[c].UserIds.IndexOf(Self.UserId) >= 0 then
      AGroupIds.Add(UserManager.Groups[c].GroupId);
end;

function TWorkflowUser.GetUserManager: TWorkflowUserManager;
begin
  if (Collection is TWorkflowUsers) and (TWorkflowUsers(Collection).GetOwner is TWorkflowUserManager) then
    result := TWorkflowUserManager(TWorkflowUsers(Collection).GetOwner)
  else
    result := nil;
end;

function TWorkflowUser.GetUserName: string;
begin
  if FUserName > '' then
    result := FUserName
  else
    result := FUserId;
end;

{ TWorkflowUserManager }

function TWorkflowUserManager.BelongsToGroup(AUserId,
  AGroupId: string): boolean;
var
  AUser: TWorkflowUser;
begin
  result := false;
  AUser := Users.FindById(AUserId);
  if AUser <> nil then
    result := AUser.BelongsToGroup(AGroupId);
end;

constructor TWorkflowUserManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUsers := TWorkflowUsers.Create(Self, TWorkflowUser);
  FGroups := TWorkflowGroups.Create(Self, TWorkflowGroup);
end;

destructor TWorkflowUserManager.Destroy;
begin
  FGroups.Free;
  FUsers.Free;
  inherited;
end;

procedure TWorkflowUserManager.FillAssignmentList(AList: TStrings;
  AddObjects: boolean = false);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    FillGroupList(SL, AddObjects);
    AList.AddStrings(SL);
    FillUserList(SL, AddObjects);
    AList.AddStrings(SL); 
  finally
    SL.Free;
  end;
end;

procedure TWorkflowUserManager.FillGroupList(AList: TStrings;
  AddObjects: boolean = false);
var
  c: integer;
  internalList: TStringList;
begin
  internalList := TStringList.Create;
  try
    internalList.Clear;
    for c := 0 to FGroups.Count - 1 do
    begin
      if AddObjects then
        internalList.AddObject(FGroups[c].GroupName, FGroups[c])
      else
        internalList.Add(FGroups[c].GroupName);
    end;
    internalList.Sort;
    AList.Assign(internalList);
  finally
    internalList.Free;
  end;
end;

procedure TWorkflowUserManager.FillUserList(AList: TStrings;
  AddObjects: boolean = false);
var
  c: integer;
  internalList: TStringList;
begin
  internalList := TStringList.Create;
  try
    internalList.Clear;
    for c := 0 to FUsers.Count - 1 do
    begin
      if AddObjects then
        internalList.AddObject(FUsers[c].UserName, FUsers[c])
      else
        internalList.Add(FUsers[c].UserName);
    end;
    internalList.Sort;
    AList.Assign(internalList);
  finally
    internalList.Free;
  end;
end;

procedure TWorkflowUserManager.GetAssignedUserList(AUserName: string; AUserList: TObjectList);
var
  AGroup: TWorkflowGroup;
  AUser: TWorkflowUser;
  c: integer;
begin
  AUserList.Clear;
  AGroup := Groups.FindByName(AUserName);
  if AGroup <> nil then
  begin
    Case WorkflowStudio.GroupAssignmentMode of
      gamMultipleTasks:
        for c := 0 to AGroup.UserIds.Count - 1 do
        begin
          AUser := Users.FindByID(AGroup.UserIds[c]);
          if AUser <> nil then
            AUserList.Add(AUser);
        end;
      gamSingleTask:
        AUserList.Add(AGroup);
    end;
  end else
  begin
    AUser := Users.FindByName(AUserName);

    if AUser <> nil then
      AUserList.Add(AUser);
  end;
end;

function TWorkflowUserManager.IsSameUser(AUserId1,
  AUserId2: string): boolean;
begin
  result := SameText(AUserId1, AUserId2);
end;

{ TTaskLogItems }

function TTaskLogItems.Add: TTaskLogItem;
begin
  result := TTaskLogItem(inherited Add);
end;

function TTaskLogItems.GetItem(Index: integer): TTaskLogItem;
begin
  result := TTaskLogItem(inherited Items[Index]);
end;

end.