wsdb.pas

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

unit wsDB;
     
{$I wsdefs.inc}

interface
uses SysUtils, Classes, Dialogs, Forms, DB, DBTables, LiveDiagram,
  atDiagram, wsClasses;

type
  TwsBindary = class(TPersistent)
  private
    //FDataSource: TDataSource;
    FKeyField: string;
    FWorkflowDB: TComponent;
    FTableName: string;
  protected
    //procedure SetDataSource(newValue: TDataSource);
    property WorkflowDB: TComponent read FWorkflowDB;
  public
    constructor Create(AWorkflowDB: TComponent); virtual;
    destructor Destroy; override;
    //procedure Notification(AComponent: TComponent; Operation: TOperation); virtual;
    //function FieldByName(FieldName: string): TField; virtual;
  published
    //property DataSource: TDataSource read FDataSource write SetDataSource;
    property TableName: string read FTableName write FTableName;
    property KeyField: string read FKeyField write FKeyField;
  end;

  TWorkInsBindary = class(TwsBindary)
  private
    FWorkflowField: string;
    FWorkDefKeyField: string;
    FCreatedOnField: string;
  public
    constructor Create(AWorkflowDB: TComponent); override;
  published
    property WorkflowField: string read FWorkflowField write FWorkflowField;
    property WorkDefKeyField: string read FWorkDefKeyField write FWorkDefKeyField;
    property CreatedOnField: string read FCreatedOnField write FCreatedOnField;
  end;

  TWorkDefBindary = class(TwsBindary)
  private
    FWorkflowField: string;
    FNameField: string;
  public
    constructor Create(AWorkflowDB: TComponent); override;
  published
    property WorkflowField: string read FWorkflowField write FWorkflowField;
    property NameField: string read FNameField write FNameField;
  end;

  TTaskInsBindary = class(TwsBindary)
  private
    FWorkInsKeyField: string;
    FNameField: string;
    FUserIdField: string;
    FWorkDefKeyField: string;
    FTaskField: string;
    {FCommentsField: string;
    FSubjectField: string;
    FDescriptionField: string;}
    FCompletedField: string;
    FCreatedOnField: string;
    FModifiedOnField: string;
    FModifiedUserIdField: string;
  public
    constructor Create(AWorkflowDB: TComponent); override;
  published
    property TaskField: string read FTaskField write FTaskField;
    property UserIdField: string read FUserIdField write FUserIdField;
    property NameField: string read FNameField write FNameField;
    {property CommentsField: string read FCommentsField write FCommentsField;
    property SubjectField: string read FSubjectField write FSubjectField;
    property DescriptionField: string read FDescriptionField write FDescriptionField;}
    property WorkInsKeyField: string read FWorkInsKeyField write FWorkInsKeyField;
    property WorkDefKeyField: string read FWorkDefKeyField write FWorkDefKeyField;
    property CompletedField: string read FCompletedField write FCompletedField;
    property CreatedOnField: string read FCreatedOnField write FCreatedOnField;
    property ModifiedOnField: string read FModifiedOnField write FModifiedOnField;
    property ModifiedUserIdField: string read FModifiedUserIdField write FModifiedUserIdField;
  end;

  TAttachmentBindary = class(TwsBindary)
  private
    FContentField: string;
    FWorkKeyField: string;
    FCreatedOnField: string;
    FObjectTypeField: string;
  public
    constructor Create(AWorkflowDB: TComponent); override;
  published
    property ContentField: string read FContentField write FContentField;
    property WorkKeyField: string read FWorkKeyField write FWorkKeyField;
    property CreatedOnField: string read FCreatedOnField write FCreatedOnField;
    property ObjectTypeField: string read FObjectTypeField write FObjectTypeField;
  end;

  TTaskLogBindary = class(TwsBindary)
  private
    FUserIdField: string;
    FInfo2Field: string;
    FOperationField: string;
    FInfoField: string;
    FEventDateField: string;
    FTaskInsKeyField: string;
  public
    constructor Create(AWorkflowDB: TComponent); override;
  published
    property TaskInsKeyField: string read FTaskInsKeyField write FTaskInsKeyField;
    property EventDateField: string read FEventDateField write FEventDateField;
    property OperationField: string read FOperationField write FOperationField;
    property UserIdField: string read FUserIdField write FUserIdField;
    property InfoField: string read FInfoField write FInfoField;
    property Info2Field: string read FInfo2Field write FInfo2Field;
  end;

  TTaskFilterType = (tfUser, tfWorkIns, tfUserList);

  TCreateQueryEvent = procedure(Sender: TObject; SQL: string;
    var Dataset: TDataset; var Done: boolean) of object;
  TAssignSQLParamsEvent = procedure(Sender: TObject; Dataset: TDataset;
    AParams: TParams; var Done: boolean) of object;
  TExecuteQueryEvent = procedure(Sender: TObject; Dataset: TDataset;
    var Done: boolean) of object;

  TAttachmentParentType = (ptDefinition, ptInstance);

  TCustomWorkflowDB = class(TComponent)
  private
    FWorkInsBindary: TWorkInsBindary;
    FTaskInsBindary: TTaskInsBindary;
    FWorkDefBindary: TWorkDefBindary;
    FTaskLogBindary: TTaskLogBindary;
    FAttachmentBindary: TAttachmentBindary;
    FParams: TParams;
    FOnCreateQuery: TCreateQueryEvent;
    FOnExecuteQuery: TExecuteQueryEvent;
    FOnAssignSQLParams: TAssignSQLParamsEvent;
    FDestroyQueries: boolean;
    //FAutoIncFields: boolean;
    function ComponentToString(AComp: TComponent): string;
    procedure ComponentFromString(AComp: TComponent; AStr: string);
    procedure WorkflowDefinitionLoadRecord(DS: TDataset; WorkDef: TWorkflowDefinition);
    procedure WorkflowInstanceLoadRecord(DS: TDataset; WorkIns: TWorkflowInstance);
    procedure TaskInstanceLoadRecord(DS: TDataset; TaskIns: TTaskInstance);
    procedure TaskLogLoadRecord(DS: TDataset; LogItem: TTaskLogItem);
    procedure AttachmentItemLoadRecord(DS: TDataset; AItem: TAttachmentItem);
    function OpenQuery(SQL: string; Params: TParams): TDataset;
    procedure ExecuteQuery(SQL: string; Params: TParams);
    function MapOperationToStr(AOperation: TTaskLogOperation): string;
    function MapStrToOperation(AStr: string): TTaskLogOperation;
    function FindNextID(ATableName, AFieldName: string): integer;
    {function SQLKeyField(AFieldName: string): string;
    function SQLKeyParam(AFieldName: string): string;}
  protected
    function BlobFieldToString(AField: TField): string; virtual;
    procedure SetBlobParam(AParam: TParam; BlobStream: string); virtual;
    function DoCreateQuery(SQL: string): TDataset; virtual;
    procedure DoAssignSQLParams(Dataset: TDataset; AParams: TParams); virtual;
    procedure DoExecuteQuery(Dataset: TDataset); virtual;
    procedure TaskInstancesDeleteByWorkIns(AWorkInsKey: string);
    procedure SaveAttachments(ADiagram: TWorkflowDiagram;
      AType: TAttachmentParentType; AWorkKey: string);
    procedure LogTaskOperation(TaskIns: TTaskInstance; Operation: TTaskLogOperation;
      Info1: string = ''; Info2: string = '');
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckDB;

    procedure TaskLogLoadList(ATaskInsKey: string; ALogItems: TTaskLogItems);
    procedure TaskInstanceInsert(TaskIns: TTaskInstance);
    procedure TaskInstanceLoad(TaskIns: TTaskInstance);
    procedure TaskInstanceUpdate(TaskIns: TTaskInstance; Inserting: boolean = false);
    procedure TaskInstanceLoadList(ATasks: TTaskInstanceList;
      AFilterType: TTaskFilterType; AFilterKey: string; OnlyIncomplete: boolean);
    procedure WorkflowInstanceInsert(WorkIns: TWorkflowInstance);
    function WorkflowInstanceLoad(WorkIns: TWorkflowInstance): boolean;
    procedure WorkflowInstanceUpdate(WorkIns: TWorkflowInstance);
    procedure WorkflowInstanceDelete(WorkIns: TWorkflowInstance);
    procedure WorkflowDefinitionDelete(WorkDef: TWorkflowDefinition);
    procedure WorkflowDefinitionInsert(WorkDef: TWorkflowDefinition);
    procedure WorkflowDefinitionUpdate(WorkDef: TWorkflowDefinition);
    procedure WorkflowDefinitionLoad(WorkDef: TWorkflowDefinition);
    procedure WorkflowDefinitionLoadList(WorkDefs: TWorkflowDefinitions);
    procedure AttachmentItemInsert(AItem: TAttachmentItem;
      AType: TAttachmentParentType; AWorkKey: string);
    function AttachmentItemLoad(AItem: TAttachmentItem): boolean;
    procedure AttachmentItemUpdate(AItem: TAttachmentItem;
      AType: TAttachmentParentType; AWorkKey: string);
    property WorkInsBindary: TWorkInsBindary read FWorkInsBindary write FWorkInsBindary;
    property WorkDefBindary: TWorkDefBindary read FWorkDefBindary write FWorkDefBindary;
    property TaskInsBindary: TTaskInsBindary read FTaskInsBindary write FTaskInsBindary;
    property TaskLogBindary: TTaskLogBindary read FTaskLogBindary write FTaskLogBindary;
    property AttachmentBindary: TAttachmentBindary read FAttachmentBindary write FAttachmentBindary;
    property OnCreateQuery: TCreateQueryEvent read FOnCreateQuery write FOnCreateQuery;
    property OnAssignSQLParams: TAssignSQLParamsEvent read FOnAssignSQLParams write FOnAssignSQLParams;
    property OnExecuteQuery: TExecuteQueryEvent read FOnExecuteQuery write FOnExecuteQuery;
    property DestroyQueries: boolean read FDestroyQueries write FDestroyQueries;
  published
  end;

  TWorkflowDB = class(TCustomWorkflowDB)
  published 
    property WorkInsBindary;
    property WorkDefBindary;
    property TaskInsBindary;
    property TaskLogBindary;
    property AttachmentBindary;
    property OnCreateQuery;
    property OnAssignSQLParams;
    property OnExecuteQuery;
    property DestroyQueries;
  end;

function DiagramToString(Diagram: TLiveDiagram): string;
procedure DiagramFromString(Diagram: TLiveDiagram; AStr: string);
function StateToString(Diagram: TLiveDiagram): string;
procedure StateFromString(Diagram: TLiveDiagram; AStr: string);
procedure wsDBError(msg: string);

implementation
uses wsRes, wsMain;

procedure wsDBError(msg: string);
begin
  raise Exception.Create(msg);
end;

procedure DiagramFromString(Diagram: TLiveDiagram;
  AStr: string);
var
  BS: TStringStream;
  oldName: string;
begin
  {avoid exception if string is empty}
  if Trim(AStr) = '' then
  begin
    Diagram.Clear;
    Exit;
  end;

  try
    BS := TStringStream.Create(AStr);
    try
      BS.Position := 0;
      oldName := Diagram.Owner.Name;
      Diagram.Owner.Name := wsFormName;
      Diagram.LoadFromStream(BS, true);
      Diagram.Owner.Name := oldName;
    finally
      BS.Free;
    end;
  except
    on E: Exception do
    begin
      ShowMessage(E.Message);
      Diagram.Clear;
      Exit;
    end;
  end;
end;

function DiagramToString(Diagram: TLiveDiagram): string;
var
  BS: TStringStream;
  oldName: string;
begin
  BS := TStringStream.Create('');
  try
    oldName := Diagram.Owner.Name;
    Diagram.Owner.Name := wsFormName;
    Diagram.SaveToStream(BS, true);

    Diagram.Owner.Name := oldName;
    BS.Position := 0;
    result := BS.ReadString(MaxInt);
  finally
    BS.Free;
  end;
end;

procedure StateFromString(Diagram: TLiveDiagram; AStr: string);
var
  BS: TStringStream;
  oldName: string;
begin
  BS := TStringStream.Create(AStr);
  try
    BS.Position := 0;
    oldName := Diagram.Owner.Name;
    Diagram.Owner.Name := wsFormName;
    Diagram.LoadStateFromStream(BS, true);
    Diagram.Owner.Name := oldName;
  finally
    BS.Free;
  end;
end;

function StateToString(Diagram: TLiveDiagram): string;
var
  BS: TStringStream;
  oldName: string;
begin
  BS := TStringStream.Create('');
  try
    oldName := Diagram.Owner.Name;
    Diagram.Owner.Name := wsFormName;
    Diagram.SaveStateToStream(BS, true);

    Diagram.Owner.Name := oldName;
    BS.Position := 0;
    result := BS.ReadString(MaxInt);
  finally
    BS.Free;
  end;
end;

{ TCustomWorkflowDB }

procedure TCustomWorkflowDB.CheckDB;
begin
end;

procedure TCustomWorkflowDB.ComponentFromString(AComp: TComponent; AStr: string);
var
  CompName: string;
  MemStream: TMemoryStream;
  StrStream: TStringStream;
begin
  MemStream := TMemoryStream.Create;
  StrStream := TStringStream.Create(AStr);
  try
    CompName := AComp.Name;
    try
      AComp.Name := '';
      StrStream.Position := 0;
      ObjectTextToBinary(StrStream, MemStream);
      MemStream.Position := 0;
      MemStream.ReadComponent(AComp);
    finally
      AComp.Name := CompName;
    end;
  finally
    MemStream.Free;
    StrStream.Free;
  end;
end;

function TCustomWorkflowDB.ComponentToString(AComp: TComponent): string;
var
  CompName:  string;
  StrStream: TStringStream;
  MemStream: TMemoryStream;
begin
  StrStream := TStringStream.Create('');
  MemStream := TMemoryStream.Create;
  try
    CompName := AComp.Name;
    try
      AComp.Name := '';
      MemStream.WriteComponent(AComp);
      MemStream.Position := 0;
      ObjectBinaryToText(MemStream, StrStream);
      StrStream.Position := 0;
      result := StrStream.ReadString(MaxInt);
    finally
      AComp.Name := CompName;
    end;