wsclasses.pas

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

unit wsClasses;

{$I wsdefs.inc}

interface
uses Windows, SysUtils, Messages, Classes, Dialogs, Contnrs, Controls, Graphics, Forms, DB,
  {$IFDEF USE_INDY}
  IdSMTP, IdMessage, IdMessageClient,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Variants,
  {$ENDIF}
  atDiagram, LiveDiagram;

type
  EWorkflowException = class(Exception);

  TWorkflowDiagram = class;

  TWorkflowDefinition = class(TCollectionItem)
  private
    FContainer: TForm;
    FDiagram: TWorkflowDiagram;
    FKey: string;
    FName: string;
    procedure SetKey(const Value: string);
    procedure SetName(const Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure AssignFromDiagram(ADiagram: TWorkflowDiagram);
    procedure AssignToDiagram(ADiagram: TWorkflowDiagram);
    property Diagram: TWorkflowDiagram read FDiagram;
    property Key: string read FKey write SetKey;
    property Name: string read FName write SetName;
  end;

  TWorkflowDefinitions = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TWorkflowDefinition;
  public
    constructor Create(AOwner: TComponent);
    function Add: TWorkflowDefinition;
    function FindByName(AName: string): TWorkflowDefinition;
    function FindByKey(AKey: string): TWorkflowDefinition;
    function FindNewName: string;
    property Items[Index: integer]: TWorkflowDefinition read GetItem; default;
  end;

  TWorkflowStatus = (wsNotStarted, wsRunning, wsFinished, wsFinishedWithError);

  TWorkflowInstance = class(TComponent)
  private
    FContainer: TForm;
    FDiagram: TWorkflowDiagram;
    FKey: string;
    FDefinitionKey: string;
    FStatus: TWorkflowStatus;
    procedure LoadDiagramProp(Reader: TReader);
    procedure StoreDiagramProp(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AssignFromDiagram(ADiagram: TWorkflowDiagram; State: boolean);
    procedure AssignToDiagram(ADiagram: TWorkflowDiagram; State: boolean);
    property Diagram: TWorkflowDiagram read FDiagram;
  published
    property Key: string read FKey write FKey;
    property DefinitionKey: string read FDefinitionKey write FDefinitionKey;
    property Status: TWorkflowStatus read FStatus write FStatus;
  end;

(*  TWorkflowInstances = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TWorkflowInstance;
  public
    constructor Create(AOwner: TComponent);
    function Add: TWorkflowInstance;
    property Items[Index: integer]: TWorkflowInstance read GetItem; default;
  end;*)

  TWorkflowVariable = class(TCollectionItem)
  private
    FName: string;
    FValue: Variant;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Name: string read FName write FName;
    property Value: Variant read FValue write FValue;
  end;

  TWorkflowVariables = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TWorkflowVariable;
  public
    function Add: TWorkflowVariable;
    function FindByName(AName: string): TWorkflowVariable;
    property Items[Index: integer]: TWorkflowVariable read GetItem; default;
  end;

  TAttachmentItem = class;

  TNotifyThread = class(TThread)
  private
    FFileName: string;
    FItem: TAttachmentItem;
    FFileAge: TDateTime;
  public
    constructor Create(AItem: TAttachmentItem; const FileName: string; OnClosed: TNotifyEvent); overload;
    destructor Destroy; override;
    procedure Execute; override;
  end;

  TAttachmentItem = class(TCollectionItem)
  private
    FName: string;
    FContent: string;
    FOriginalName: string;
    FKey: string;
    FDirtyContent: boolean;
    FNotifyThread: TNotifyThread;
    FSaveCursor: TCursor;
    function GetContent: string;
    procedure SetContent(const Value: string);
    function IsContentStored: Boolean;
    function GetExtension: string;
    procedure ShellAppClosed(Sender: TObject);
    procedure CursorHourGlass;
    procedure DoShellOpen(AFileName: string; AllowEdit: boolean);
    procedure CursorDefault;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure LoadContentFromFile(AFileName: string);
    procedure SaveContentToFile(AFileName: string);
    procedure Open(AllowEdit: boolean; APath: string = '');
    property Extension: string read GetExtension;
  published
    property Name: string read FName write FName;
    property OriginalName: string read FOriginalName write FOriginalName;
    property Key: string read FKey write FKey;
    property DirtyContent: boolean read FDirtyContent write FDirtyContent;
    property Content: string read GetContent write SetContent stored IsContentStored;
  end;

  TAttachmentItems = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TAttachmentItem;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TAttachmentItem;
    function FindByName(AName: string): TAttachmentItem;
    function AddFile(AFileName: string): TAttachmentItem;
    property Items[Index: integer]: TAttachmentItem read GetItem; default;
  end;

  TWorkflowAttachment = class(TCollectionItem)
  private
    FName: string;
    FItems: TAttachmentItems;
    procedure SetItems(const Value: TAttachmentItems);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Name: string read FName write FName;
    property Items: TAttachmentItems read FItems write SetItems;
  end;

  TWorkflowAttachments = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TWorkflowAttachment;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TWorkflowAttachment;
    function FindByName(AName: string): TWorkflowAttachment;
    function AddFile(AName: string; AFileName: string): TAttachmentItem;
    procedure MakeAllDirty;
    property Items[Index: integer]: TWorkflowAttachment read GetItem; default;
  end;

  TWorkflowDiagram = class(TLiveDiagram)
  private
    FWorkflowInstance: TWorkflowInstance;
    FVariables: TWorkflowVariables;
    FAttachments: TWorkflowAttachments;
    procedure SetVariables(const Value: TWorkflowVariables);
    procedure SetAttachments(const Value: TWorkflowAttachments);
  protected
    procedure DoSaveState; override;
    function DiagramStreamClass: TatDiagramClass; override;
    procedure DoBeforeExecuteNode(ANode: TCustomLiveBlock); override;
    procedure DoAfterExecuteNode(ANode: TCustomLiveBlock); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property WorkflowInstance: TWorkflowInstance read FWorkflowInstance;
    procedure SaveToStream(AStream: TStream; TextFormat: boolean = false); override;
    procedure LoadFromStream(AStream: TStream; TextFormat: boolean = false); override;
  published
    property Variables: TWorkflowVariables read FVariables write SetVariables;
    property Attachments: TWorkflowAttachments read FAttachments write SetAttachments;
  end;

  TWorkflowStreamDiagram = class(TWorkflowDiagram)
  private
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  protected
  public
    procedure PaintWindow(DC: HDC); override;
    constructor Create(Owner: TComponent); override;
  end;

  TWorkflowEngine = class
  private
    procedure WorkflowTerminated(Sender : TLiveDiagram; ExitCode : integer);
    procedure WorkflowSaveState(Sender: TObject);
  public
    procedure RunWorkflow(WorkIns: TWorkflowInstance);
  end;

type
  TAttachmentPermission = (apDelete, apInsert, apEdit);
  TAttachmentPermissions = set of TAttachmentPermission;

const
  AllAttachmentPermissions = [apDelete, apInsert, apEdit];

type
  TTaskField = class(TCollectionItem)
  private
    FRequired: boolean;
    FReadOnly: boolean;
    FCaption: string;
    FWorkflowVarName: string;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Caption: string read FCaption write FCaption;
    property ReadOnly: boolean read FReadOnly write FReadOnly;
    property Required: boolean read FRequired write FRequired;
    property WorkflowVarName: string read FWorkflowVarName write FWorkflowVarName;
    //property EditorType (dropdown, check, freeedit, date)
    //property DecisionMaker: boolean
    //property DropDownOptions
  end;

  TTaskFields = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TTaskField;
  public
    function Add: TTaskField;
    property Items[Index: integer]: TTaskField read GetItem; default;
  end;

  TTaskDefinition = class(TCollectionItem)
  private
    FDescription: string;
    FName: string;
    FAssignmentRule: string;            
    FStatusList: TStrings;
    FTaskInstanceKeys: TStrings;
    FPreviousTaskInsKeys: TStrings;
    FKey: string;
    FSubject: string;
    FMailNotification: boolean;
    FShowAttachments: boolean;
    FAttachmentPermissions: TAttachmentPermissions;
    FFields: TTaskFields;
    procedure SetStatusList(const Value: TStrings);
    function GetInitialStatus: string;
    procedure SetFields(const Value: TTaskFields);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function IsCompletionStatus(AStatus: string): boolean;
    procedure FillStatusList(AList: TStrings);
    property InitialStatus: string read GetInitialStatus;
  published
    property Key: string read FKey write FKey;
    property Name: string read FName write FName;
    property Subject: string read FSubject write FSubject;
    property Description: string read FDescription write FDescription;
    property AssignmentRule: string read FAssignmentRule write FAssignmentRule;
    property StatusList: TStrings read FStatusList write SetStatusList;
    property TaskInstanceKeys: TStrings read FTaskInstanceKeys write FTaskInstanceKeys;
    property PreviousTaskInsKeys: TStrings read FPreviousTaskInsKeys write FPreviousTaskInsKeys;
    property MailNotification: boolean read FMailNotification write FMailNotification;
    property ShowAttachments: boolean read FShowAttachments write FShowAttachments;
    property AttachmentPermissions: TAttachmentPermissions read FAttachmentPermissions write FAttachmentPermissions;
    property Fields: TTaskFields read FFields write SetFields;
  end;

  TTaskDefinitions = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TTaskDefinition;
  public
    constructor Create(AOwner: TComponent);
    function Add: TTaskDefinition;
    function FindByName(AName: string): TTaskDefinition;
    property Items[Index: integer]: TTaskDefinition read GetItem; default;
    function GetOwner: TPersistent; override;
  end;

  TTaskInstance = class(TComponent)
  private
    FContainer: TDataModule;
    FDiagram: TLiveDiagram;
    FComments: string;
    FStatus: string;
    FUserID: string;
    FKey: string;
    FWorkInsKey: string;
    FTaskDef: TTaskDefinition;
    FDefinitionKey: string;
    FCreatedOn: TDateTime;
    procedure SetTaskDef(const Value: TTaskDefinition);
    function GetCompleted: boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    {Returns true if the user specified by AUserId can update the task}
    function CanUpdate(AUserId: string): boolean;
    function IsCompletionStatus(AStatus: string): boolean;
    property Completed: boolean read GetCompleted;
  published
    property Key: string read FKey write FKey;
    property WorkInsKey: string read FWorkInsKey write FWorkInsKey;
    property DefinitionKey: string read FDefinitionKey write FDefinitionKey;

    {Note: UserId can be an id for a user or a group}
    property UserID: string read FUserID write FUserID;
    property Status: string read FStatus write FStatus;
    property Comments: string read FComments write FComments;
    property TaskDef: TTaskDefinition read FTaskDef write SetTaskDef;
    property CreatedOn: TDateTime read FCreatedOn write FCreatedOn;
  end;

  TTaskInstanceItem = class(TCollectionItem)
  private
    FTask: TTaskInstance;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Task: TTaskInstance read FTask;
  end;

  TTaskInstanceList = class(TCollection)
  private
    function GetItem(index: integer): TTaskInstanceItem;
  public
    function Add: TTaskInstanceItem;
    property Items[index: integer]: TTaskInstanceItem read GetItem; default;
  end;

  TTaskLogOperation = (tlNone, tlStatusChange, tlUpdate, tlCreate);

  TTaskLogItem = class(TCollectionItem)
  private
    FTaskInsKey: string;
    FInfo: string;
    FUserId: string;
    FEventDate: TDateTime;
    FOperation: TTaskLogOperation;
    FInfo2: string;
  public
    property Operation: TTaskLogOperation read FOperation write FOperation;
    property TaskInsKey: string read FTaskInsKey write FTaskInsKey;
    property EventDate: TDateTime read FEventDate write FEventDate;
    property UserId: string read FUserId write FUserId;
    property Info: string read FInfo write FInfo;
    property Info2: string read FInfo2 write FInfo2;
  end;

  TTaskLogItems = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TTaskLogItem;
  public
    function Add: TTaskLogItem;
    property Items[Index: integer]: TTaskLogItem read GetItem; default;
  end;

  TScriptContext = (scRuntimeInstance, scDesignDiagram);

  TWorkflowScriptEngine = class(TComponent)
  private
    FExprDelim: string;
    FWorkIns: TWorkflowInstance;
    FRunContext: TScriptContext;
    FDiagram: TWorkflowDiagram;
    function ExtractExpression(AText, OpenDelim, CloseDelim: string; var i,
      j: Integer): string;
  protected
    function ExpressionToStr(Value: Variant): string;
    property WorkflowInstance: TWorkflowInstance read FWorkIns;
    property Diagram: TWorkflowDiagram read FDiagram;
    procedure RunContextChanged; virtual; abstract;
    property RunContext: TScriptContext read FRunContext;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetRuntimeContext(AWorkIns: TWorkflowInstance);
    procedure SetDesignContext(ADiagram: TWorkflowDiagram);
    function CalculateExpression(Expr: string): Variant; virtual;
    function TranslateText(AText: string): string;
  end;

  TWorkflowUserManager = class;

  TWorkflowUser = class(TCollectionItem)
  private
    FUserName: string;
    FEmail: string;
    FUserId: string;
    function GetUserName: string;
    function GetUserManager: TWorkflowUserManager;
  public
    property UserManager: TWorkflowUserManager read GetUserManager;

    {Fill a string list with the list of group id's to which the user belongs to} 
    procedure FillGroupIds(AGroupIds: TStrings);

    {Returns true if the user belongs to the group specified by AGroupId}
    function BelongsToGroup(AGroupId: string): boolean;
  published
    property UserName: string read GetUserName write FUserName;
    property UserId: string read FUserId write FUserId;
    property Email: string read FEmail write FEmail;
  end;

  TWorkflowUsers = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TWorkflowUser;
  public
    function FindById(AName: string): TWorkflowUser;
    function FindByName(AName: string): TWorkflowUser;
    function Add: TWorkflowUser; overload;
    function Add(AUserID: string; AUserName: string = ''; AEmail: string = ''): TWorkflowUser; overload;
    property Items[Index: integer]: TWorkflowUser read GetItem; default;
  end;

  TWorkflowGroup = class(TCollectionItem)
  private
    FGroupName: string;
    FUserIds: TStrings;
    FGroupId: string;
    procedure SetUserIds(const Value: TStrings);
    function GetUserManager: TWorkflowUserManager;
    function GetGroupId: string;
    function GetGroupName: string;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property UserManager: TWorkflowUserManager read GetUserManager;
  published
    property GroupId: string read GetGroupId write FGroupId;
    property GroupName: string read GetGroupName write FGroupName;
    property UserIds: TStrings read FUserIds write SetUserIds;
  end;

  TWorkflowGroups = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TWorkflowGroup;
  public
    function FindByName(AName: string): TWorkflowGroup;
    function FindByID(AId: string): TWorkflowGroup;
    function Add: TWorkflowGroup; overload;
    {The function below adds a group with name specified by AGroupName. The GroupID property will also
     be set with AGroupName}
    function Add(AGroupName: string): TWorkflowGroup; overload;
    function Add(AGroupID: string; AGroupName: string): TWorkflowGroup; overload;
    property Items[Index: integer]: TWorkflowGroup read GetItem; default;
  end;

  TWorkflowUserManager = class(TComponent)
  private
    FUsers: TWorkflowUsers;
    FGroups: TWorkflowGroups;
    FLoggedUserId: string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    {Fill the AUserList object with a list of TWorkflowUser and/or TWorkflowGroup objects based on the name specified by AUserName.
     The AUserName can be the name of an user or a group. The objects filled depends also on the value of WorkflowStudio.GroupAssignedMode property.
     In summary, this function translates the assignment text specified by the end-user in the task definition dialog, to a list of objects
     to which the task must be assigned}
    procedure GetAssignedUserList(AUserName: string; AUserList: TObjectList);

    {Fill the AList with the names of all users and groups, for the purpose of choosing an user or group from a list.
     if AddObjects is true, the method will also add a reference to the object in the AList.Objects[] property}
    procedure FillAssignmentList(AList: TStrings; AddObjects: boolean = false);
    procedure FillUserList(AList: TStrings; AddObjects: boolean = false);
    procedure FillGroupList(AList: TStrings; AddObjects: boolean = false);

    {Returns true if both userids are the same}
    function IsSameUser(AUserId1, AUserId2: string): boolean;

    {Returns true if AUserId belongs to group specified by AGroupId}
    function BelongsToGroup(AUserId, AGroupId: string): boolean;
    property Users: TWorkflowUsers read FUsers;
    property Groups: TWorkflowGroups read FGroups;
    property LoggedUserId: string read FLoggedUserId write FLoggedUserId;
  end;

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