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

📄 wsmain.pas

📁 Workflow Studio是一款专为商业进程管理(BPM)设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit wsMain;

{$I wsdefs.inc}

interface
uses SysUtils, Classes, DB, Contnrs,
  {$IFDEF USE_INDY}
  IdSMTP, IdMessage, IdMessageClient,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Variants,
  {$ENDIF}
  wsClasses, wsDB, LiveDiagram, wsBlocks;

type
  TWorkflowManager = class(TComponent)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadWorkflowDefinitionList(WorkDefs: TWorkflowDefinitions);
    function FindWorkflowDefinitionByName(AName: string): TWorkflowDefinition;

    function CreateWorkflowDefinitionList: TWorkflowDefinitions;
    function CreateWorkflowInstance(WorkDef: TWorkflowDefinition): TWorkflowInstance;
    function CreateWorkflowInstanceByName(WorkDefName: string): TWorkflowInstance;
    function CreateWorkflowInstanceByKey(AKey: string): TWorkflowInstance;
    function FindWorkflowInstanceByKey(AKey: string): TWorkflowInstance;

    procedure DeleteWorkflowInstance(WorkIns: TWorkflowInstance);
    procedure DeleteWorkflowInstanceByKey(WorkInsKey: string);

    procedure SignalWorkflowInstance(AKey: string);
    procedure LoadWorkflowInstance(WorkIns: TWorkflowInstance);
    procedure SaveWorkflowInstance(WorkIns: TWorkflowInstance);
    procedure SaveWorkflowDefinition(WorkDef: TWorkflowDefinition);
    procedure LoadWorkflowDefinition(AKey: string; WorkDef: TWorkflowDefinition);
    procedure DeleteWorkflowDefinition(WorkDef: TWorkflowDefinition);
    procedure AssignWorkflowInstanceDiagram(ADiagram: TWorkflowDiagram; WorkInsKey: string);
  end;

  TTaskManager = class(TComponent)
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateTaskInstance(WorkIns: TWorkflowInstance; TaskDef: TTaskDefinition);
    procedure LoadTaskInstance(TaskIns: TTaskInstance);
    procedure SaveTaskInstance(TaskIns: TTaskInstance);
    function IsTaskFinished(AKey: string): boolean;
    procedure LoadTaskInstanceList(ATasks: TTaskInstanceList;
      AFilterType: TTaskFilterType; AFilterKey: string; OnlyCompleted: boolean);
  end;

  TWorkflowFormMode = (wfmModal, wfmMDI);

  TCustomWorkflowUserInterface = class(TComponent)
  public
    procedure ShowUserTasksDlg(AUserKey: string; AFormMode: TWorkflowFormMode = wfmModal); virtual; abstract;
    procedure ShowUsersTasksDlg(AUserKeys: string; AFormMode: TWorkflowFormMode = wfmModal); virtual; abstract;
    procedure ShowWorkInsTasksDlg(AWorkInsKey: string; AFormMode: TWorkflowFormMode = wfmModal); virtual; abstract;
    procedure ShowWorkflowDefinitionsDlg; virtual; abstract;
    procedure EditWorkflowDefinition(AWorkDef: TWorkflowDefinition); virtual; abstract;
  end;

  TUserInterfaceClass = class of TCustomWorkflowUserInterface;

  TEmailInformation = record
    ToAddr: string;
    From: string;
    Bcc: string;
    Cc: string;
    Subject: string;
    Text: string;
  end;

  TSendMailEvent = procedure(Sender: TObject; TaskIns: TTaskInstance; AUser: TWorkflowUser; AEmailInfo: TEmailInformation; var Sent: boolean) of object;
  TWorkInsErrorEvent = procedure(Sender: TObject; WI: TWorkflowInstance; ErrMsg: string; var ShowError: boolean) of object;
  TWorkflowBlockEvent = procedure(Sender: TObject; ABlock: TCustomWorkflowBlock) of object;
  TWorkflowTaskEvent = procedure(Sender: TObject; ATaskIns: TTaskInstance) of object;

  {Group assignment mode defines what happen when a task is assigned to a group (not an user).

   gamMultipleTasks: A task will be created for each user in the group. So, if a group has users "john" and "maria",
   one task will be createed for John, and antoher to Maria, and the tasks will be independent (both will have to be concluded)

   gamSingleTask: A single task will be created that will be visible for all users in the group. If you later include/remove
   users to/from the group, the existing tasks will become not visible for users removed from the group, and will become visible
   to users added to group. Any user from the group can update the task, including finishing it.} 
  TGroupAssignmentMode = (gamMultipleTasks, gamSingleTask);

  TWorkflowStudio = class(TComponent)
  private
    FTaskManager: TTaskManager;
    FWorkflowDB: TCustomWorkflowDB;
    FInternalScriptEngine: TWorkflowScriptEngine;
    FInternalUserInterface: TCustomWorkflowUserInterface;
    FScriptEngine: TWorkflowScriptEngine;
    FWorkflowEngine: TWorkflowEngine;
    FWorkflowManager: TWorkflowManager;
    FUserManager: TWorkflowUserManager;
    FOnSendMail: TSendMailEvent;
    FFromEmail: string;
    FOnWorkInsError: TWorkInsErrorEvent;
    {$IFDEF USE_INDY}
    FIndySMTP: TidSMTP;
    {$ENDIF}
    FOnAfterExecuteNode: TWorkflowBlockEvent;
    FOnBeforeExecuteNode: TWorkflowBlockEvent;
    FOnTaskCreated: TWorkflowTaskEvent;
    FOnTaskFinished: TWorkflowTaskEvent;
    FGroupAssignmentMode: TGroupAssignmentMode;
    {$IFDEF USE_INDY}
    procedure SetIndySMTP(const Value: TidSMTP);
    {$ENDIF}
    procedure SeTCustomWorkflowDB(const Value: TCustomWorkflowDB);
    function GeTCustomWorkflowDB: TCustomWorkflowDB;
    function GetScriptEngine: TWorkflowScriptEngine;
    procedure SetScriptEngine(const Value: TWorkflowScriptEngine);
    function GetUserInterface: TCustomWorkflowUserInterface;
    procedure SetGroupAssignmentMode(const Value: TGroupAssignmentMode);
    procedure SendGroupMail(TaskIns: TTaskInstance; AGroup: TWorkflowGroup; EMailInfo: TEmailInformation);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function SendMail(TaskIns: TTaskInstance; AUser: TWorkflowUser; EMailInfo: TEmailInformation): boolean;
    procedure WorkflowInstanceError(WI: TWorkflowInstance; ErrMsg: string; var ShowError: boolean);
    {$IFDEF USE_INDY}
    function IndySendMail(EMailInfo: TEmailInformation): boolean;
    {$ENDIF}
    property WorkflowManager: TWorkflowManager read FWorkflowManager;
    property TaskManager: TTaskManager read FTaskManager;
    property WorkflowEngine: TWorkflowEngine read FWorkflowEngine;
    property UserManager: TWorkflowUserManager read FUserManager;
    property ScriptEngine: TWorkflowScriptEngine read GetScriptEngine write SetScriptEngine;
    property UserInterface: TCustomWorkflowUserInterface read GetUserInterface;
  published
    property WorkflowDB: TCustomWorkflowDB read GeTCustomWorkflowDB write SeTCustomWorkflowDB;
    property FromEmail: string read FFromEmail write FFromEmail;
    property GroupAssignmentMode: TGroupAssignmentMode read FGroupAssignmentMode write SetGroupAssignmentMode;
    property OnSendMail: TSendMailEvent read FOnSendMail write FOnSendMail;
    {$IFDEF USE_INDY}
    property IndySMTP: TidSMTP read FIndySMTP write SetIndySMTP;
    {$ENDIF}
    property OnWorkInsError: TWorkInsErrorEvent read FOnWorkInsError write FOnWorkInsError;
    property OnBeforeExecuteNode: TWorkflowBlockEvent read FOnBeforeExecuteNode write FOnBeforeExecuteNode;
    property OnAfterExecuteNode: TWorkflowBlockEvent read FOnAfterExecuteNode write FOnAfterExecuteNode;
    property OnTaskCreated: TWorkflowTaskEvent read FOnTaskCreated write FOnTaskCreated;
    property OnTaskFinished: TWorkflowTaskEvent read FOnTaskFinished write FOnTaskFinished;
  end;

  TWorkflowScriptEngineClass = class of TWorkflowScriptEngine;

var
  WorkflowStudio: TWorkflowStudio;
  ScriptEngineClass: TWorkflowScriptEngineClass;
  UserInterfaceClass: TUserInterfaceClass;

implementation
uses wsRes, wsScripter, wsUserInterface;

{ TWorkflowManager }

procedure TWorkflowManager.AssignWorkflowInstanceDiagram(
  ADiagram: TWorkflowDiagram; WorkInsKey: string);
var
  WorkIns: TWorkflowInstance;
begin
  WorkIns := TWorkflowInstance.Create(nil);
  try
    WorkIns.Key := WorkInsKey;
    LoadWorkflowInstance(WorkIns);
    WorkIns.AssignToDiagram(ADiagram, true);
  finally
    WorkIns.Free;
  end;
end;

constructor TWorkflowManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

function TWorkflowManager.CreateWorkflowDefinitionList: TWorkflowDefinitions;
begin
  result := TWorkflowDefinitions.Create(nil);
  WorkflowStudio.WorkflowDB.WorkflowDefinitionLoadList(result);
end;

function TWorkflowManager.CreateWorkflowInstance(
  WorkDef: TWorkflowDefinition): TWorkflowInstance;
begin
  if WorkDef <> nil then
  begin
    result := TWorkflowInstance.Create(nil);
    result.AssignFromDiagram(WorkDef.Diagram, false);
    result.DefinitionKey := WorkDef.Key;
    {Allow copying attachments from definition to instance.}
    result.Diagram.Attachments.MakeAllDirty;
    WorkflowStudio.WorkflowDB.WorkflowInstanceInsert(result);
  end else
    result := nil;
end;

function TWorkflowManager.CreateWorkflowInstanceByKey(
  AKey: string): TWorkflowInstance;
var
  WorkDefs: TWorkflowDefinitions;
  WorkDef: TWorkflowDefinition;
begin
  result := nil;
  WorkDefs := WorkflowStudio.WorkflowManager.CreateWorkflowDefinitionList;
  try
    WorkDef := WorkDefs.FindByKey(AKey);
    if WorkDef <> nil then
      result := CreateWorkflowInstance(WorkDef);
  finally
    WorkDefs.Free;
  end;
end;

function TWorkflowManager.CreateWorkflowInstanceByName(
  WorkDefName: string): TWorkflowInstance;
var
  WorkDefs: TWorkflowDefinitions;
  WorkDef: TWorkflowDefinition;
begin
  result := nil;
  WorkDefs := WorkflowStudio.WorkflowManager.CreateWorkflowDefinitionList;
  try
    WorkDef := WorkDefs.FindByName(WorkDefName);
    if WorkDef <> nil then
      result := CreateWorkflowInstance(WorkDef);
  finally
    WorkDefs.Free;
  end;
end;

procedure TWorkflowManager.DeleteWorkflowDefinition(
  WorkDef: TWorkflowDefinition);
begin
  WorkflowStudio.WorkflowDB.WorkflowDefinitionDelete(WorkDef);
end;

procedure TWorkflowManager.DeleteWorkflowInstance(
  WorkIns: TWorkflowInstance);
begin
  WorkflowStudio.WorkflowDB.WorkflowInstanceDelete(WorkIns); 
end;

procedure TWorkflowManager.DeleteWorkflowInstanceByKey(WorkInsKey: string);
var
  WorkIns: TWorkflowInstance;
begin
  WorkIns := TWorkflowInstance.Create(nil);
  try
    WorkIns.Key := WorkInsKey;
    DeleteWorkflowInstance(WorkIns);
  finally
    WorkIns.Free;
  end;
end;

destructor TWorkflowManager.Destroy;
begin
  inherited;
end;

function TWorkflowManager.FindWorkflowDefinitionByName(
  AName: string): TWorkflowDefinition;
var
  WorkDefs: TWorkflowDefinitions;
  WorkDef: TWorkflowDefinition;
begin
  result := nil;
  WorkDefs := CreateWorkflowDefinitionList;
  try
    WorkDef := WorkDefs.FindByName(AName);
    if WorkDef <> nil then
    begin
      result := TWorkflowDefinition.Create(nil);
      result.Key := WorkDef.Key;
      
      {must load in a different object (result) instead of WorkDef, because WorkDef
       will be destroyed when WorkDefs.Free is called}
      LoadWorkflowDefinition(WorkDef.Key, result);
    end;
  finally
    WorkDefs.Free;
  end;
end;

function TWorkflowManager.FindWorkflowInstanceByKey(
  AKey: string): TWorkflowInstance;
begin
  result := TWorkflowInstance.Create(nil);
  result.Key := AKey;
  if not WorkflowStudio.WorkflowDB.WorkflowInstanceLoad(result) then
  begin
    result.Free;
    result := nil;
  end;
end;

procedure TWorkflowManager.LoadWorkflowDefinition(
  AKey: string; WorkDef: TWorkflowDefinition);
begin
  WorkDef.Key := AKey;
  WorkflowStudio.WorkflowDB.WorkflowDefinitionLoad(WorkDef);
end;

procedure TWorkflowManager.LoadWorkflowDefinitionList(
  WorkDefs: TWorkflowDefinitions);
begin
  WorkflowStudio.WorkflowDB.WorkflowDefinitionLoadList(WorkDefs);
end;

procedure TWorkflowManager.LoadWorkflowInstance(
  WorkIns: TWorkflowInstance);
begin
  if not WorkflowStudio.WorkflowDB.WorkflowInstanceLoad(WorkIns) then
    wsDBError(Format(_str(SErrorRecordNotFoundKey), ['workflow instance', WorkIns.Key]));
end;

procedure TWorkflowManager.SaveWorkflowDefinition(
  WorkDef: TWorkflowDefinition);
begin
  if WorkDef.Key = '' then
    WorkflowStudio.WorkflowDB.WorkflowDefinitionInsert(WorkDef)
  else
    WorkflowStudio.WorkflowDB.WorkflowDefinitionUpdate(WorkDef);
end;

procedure TWorkflowManager.SaveWorkflowInstance(
  WorkIns: TWorkflowInstance);
begin
  if WorkIns.Key = '' then
    WorkflowStudio.WorkflowDB.WorkflowInstanceInsert(WorkIns)
  else
    WorkflowStudio.WorkflowDB.WorkflowInstanceUpdate(WorkIns);
end;

procedure TWorkflowManager.SignalWorkflowInstance(AKey: string);
var
  WI: TWorkflowInstance;
begin
  WI := TWorkflowInstance.Create(nil);
  WI.Key := AKey;
  LoadWorkflowInstance(WI);

⌨️ 快捷键说明

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