wsdb.pas

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

        end;

        ExecuteQuery(SQL, FParams);

        {Now compare the new task instance with the old one. If Inserting is true, it means
         that this update is to complete an insert operation, so there is no need for a log.
         If the status has change, log it}
        if not Inserting then
        begin
          if CompareText(TaskIns.Status, TaskInsOld.Status) <> 0 then
          begin
            LogTaskOperation(TaskIns, tlStatusChange, TaskInsOld.Status, TaskIns.Status);

            {if the status was changed and the task is completed, it means that the task
             was just finished now - fire the event}
            if Assigned(WorkflowStudio.OnTaskFinished) then
              WorkflowStudio.OnTaskFinished(WorkflowStudio, TaskIns);
          end;
          LogTaskOperation(TaskIns, tlUpdate);
        end else
        begin
          {if task was inserted then call OnTaskCreated event}
          if Assigned(WorkflowStudio.OnTaskCreated) then
            WorkflowStudio.OnTaskCreated(WorkflowStudio, TaskIns);
        end;
      finally
        TaskInsOld.Free;
      end;
    end else
      wsDBError(Format(_str(SErrorUpdateEmptyKey), [TableName]));
  end;
end;

procedure TCustomWorkflowDB.WorkflowDefinitionDelete(
  WorkDef: TWorkflowDefinition);
var
  SQL: string;
begin
  if WorkDef.Key <> '' then
  begin
    SQL := Format('DELETE FROM %s WHERE %s = :id',
      [WorkDefBindary.TableName, WorkDefBindary.KeyField]);
    FParams.Clear;
    FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkDef.Key);
    ExecuteQuery(SQL, FParams);
  end else
    wsDBError(Format(_str(SErrorDeleteEmptyKey), ['workflow definition']));
end;

procedure TCustomWorkflowDB.WorkflowDefinitionInsert(WorkDef: TWorkflowDefinition);
var
  SQL: string;
begin
  CheckDB;
  With WorkDefBindary do
  begin
    {Insert workdefinition unique key}
    (*SQL := Format('INSERT INTO %s (%s%s) Values (%s:name)',
      [TableName, SQLKeyField(KeyField), NameField, SQLKeyParam(KeyField)]);
    FParams.Clear;
    //if not FAutoIncFields then
      FParams.CreateParam(ftInteger, KeyField, ptInput).AsInteger := FindNextID(TableName, KeyField);
    FParams.CreateParam(ftString, 'name', ptInput).AsString := WorkDef.Name;
    ExecuteQuery(SQL, FParams);

    {retrieve the generated key}
    SQL := Format('SELECT %s FROM %s WHERE %s = :name',
      [KeyField, TableName, NameField]);
    DS := OpenQuery(SQL, FParams);
    try
      WorkDef.Key := DS.FieldByName(KeyField).AsString;
      if WorkDef.Key = '' then
        wsDBError(Format(_str(SErrorInsertCannotGetKey), [TableName]));
    finally
      DS.Close;
      if DestroyQueries then
        DS.Free;
    end;*)

    WorkDef.Key := IntToStr(FindNextID(TableName, KeyField));
    SQL := Format('INSERT INTO %s (%s) Values (:id)',
      [TableName, KeyField]);
    FParams.Clear;
    FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkDef.Key);
    ExecuteQuery(SQL, FParams);

    {Save other workflow definition fields}
    WorkflowDefinitionUpdate(WorkDef);
  end;
end;

procedure TCustomWorkflowDB.WorkflowDefinitionLoad(WorkDef: TWorkflowDefinition);
var
  SQL: string;
  DS: TDataset;
begin
  CheckDB;
  SQL := Format('SELECT * from %s WHERE %s = :id',
    [WorkDefBindary.TableName, WorkDefBindary.KeyField]);
  FParams.Clear;
  FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkDef.Key);
  DS := OpenQuery(SQL, FParams);
  try
    if not DS.IsEmpty then
      WorkflowDefinitionLoadRecord(DS, WorkDef)
    else
      wsDBError(Format(_str(SErrorRecordNotFoundKey), [WorkDefBindary.TableName, WorkDef.Key]));
  finally
    DS.Close;
    if DestroyQueries then
      DS.Free;
  end;
end;

procedure TCustomWorkflowDB.WorkflowDefinitionLoadList(
  WorkDefs: TWorkflowDefinitions);
var
  DS: TDataset;
begin
  CheckDB;
  FParams.Clear;
  DS := OpenQuery(Format('SELECT * from %s', [WorkDefBindary.TableName]), FParams);
  try
    DS.First;
    WorkDefs.Clear;
    while not DS.EOF do
    begin
      WorkflowDefinitionLoadRecord(DS, WorkDefs.Add);
      DS.Next;
    end;
  finally
    //DS.Close;
    if DestroyQueries then
      DS.Free;
  end;
end;

function TCustomWorkflowDB.BlobFieldToString(AField: TField): string;
begin
  result := AField.AsString;
end;

procedure TCustomWorkflowDB.WorkflowDefinitionLoadRecord(DS: TDataset;
  WorkDef: TWorkflowDefinition);
begin
  With WorkDefBindary do
  begin
    DiagramFromString(WorkDef.Diagram, BlobFieldToString(DS.FieldByName(WorkflowField)));
    WorkDef.Name := DS.FieldByName(NameField).AsString;
    WorkDef.Key := DS.FieldByName(KeyField).AsString;
  end;
end;

procedure TCustomWorkflowDB.WorkflowDefinitionUpdate(
  WorkDef: TWorkflowDefinition);
var
  SQL: string;
begin
  CheckDB;
  With WorkDefBindary do
  begin
    if WorkDef.Key <> '' then
    begin
      SQL := Format('UPDATE %s SET '+
        '%s = :workflow, '+
        '%s = :name '+
        'WHERE %s = :id',
        [TableName, WorkflowField, NameField, KeyField]);
      FParams.Clear;
      FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkDef.Key);

      {Save diagram attachments - it must be BEFORE streaming the diagram, because SaveAttachments procedure
       sets the key value for each attachment item. The diagram should be streamed only after a key value
       is assigned and after DirtyContent property is set to false}
      SaveAttachments(WorkDef.Diagram, ptDefinition, WorkDef.Key);
      FParams.Clear;
      FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkDef.Key);
      FParams.CreateParam(ftMemo, 'workflow', ptInput).AsMemo := DiagramToString(WorkDef.Diagram);
      FParams.CreateParam(ftString, 'name', ptInput).AsString := WorkDef.Name;
      ExecuteQuery(SQL, FParams);

    end else
      wsDBError(Format(_str(SErrorUpdateEmptyKey), [TableName]));
  end;
end;

procedure TCustomWorkflowDB.WorkflowInstanceDelete(WorkIns: TWorkflowInstance);
var
  SQL: string;
begin
  if WorkIns.Key <> '' then
  begin
    SQL := Format('DELETE FROM %s WHERE %s = :id',
      [WorkInsBindary.TableName, WorkInsBindary.KeyField]);
    FParams.Clear;
    FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkIns.Key);
    ExecuteQuery(SQL, FParams);

    TaskInstancesDeleteByWorkIns(WorkIns.Key);
  end else
    wsDBError(Format(_str(SErrorDeleteEmptyKey), ['workflow instance']));
end;

procedure TCustomWorkflowDB.WorkflowInstanceInsert(WorkIns: TWorkflowInstance);
var
  SQL: string;
  CreatedOn: TDateTime;
begin
  CheckDB;
  CreatedOn := Now;
  With WorkInsBindary do
  begin
    (*{Insert workinstance unique key}
    SQL := Format('INSERT INTO %s (%s%s, %s) Values (%s:workdefkey, :createdon)',
      [TableName, SQLKeyField(KeyField), WorkDefKeyField, CreatedOnField, SQLKeyParam(KeyField)]);
    FParams.Clear;
    //if not FAutoIncFields then
      FParams.CreateParam(ftInteger, KeyField, ptInput).AsInteger := FindNextID(TableName, KeyField);
    FParams.CreateParam(ftInteger, 'workdefkey', ptInput).AsInteger := StrToInt(WorkIns.DefinitionKey);
    FParams.CreateParam(ftDateTime, 'createdon', ptInput).AsDateTime := CreatedOn;
    ExecuteQuery(SQL, FParams);

    {retrieve the generated key}
    SQL := Format('SELECT %s FROM %s WHERE %s = :workdefkey AND %s = :createdon',
      [KeyField, TableName, WorkDefKeyField, CreatedOnField]);
    DS := OpenQuery(SQL, FParams);
    try
      WorkIns.Key := DS.FieldByName(KeyField).AsString;
      if WorkIns.Key = '' then
        wsDBError(Format(_str(SErrorInsertCannotGetKey), [TableName]));
    finally
      DS.Close;
      if DestroyQueries then
        DS.Free;
    end;*)

    WorkIns.Key := IntToStr(FindNextID(TableName, KeyField));
    SQL := Format('INSERT INTO %s (%s, %s) Values (:id, :createdon)',
      [TableName, KeyField, CreatedOnField]);
    FParams.Clear;
    FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkIns.Key);
    FParams.CreateParam(ftDateTime, 'createdon', ptInput).AsDateTime := CreatedOn;
    ExecuteQuery(SQL, FParams);

    {Save other workflow instance fields}
    WorkflowInstanceUpdate(WorkIns);
  end;
end;

function TCustomWorkflowDB.WorkflowInstanceLoad(WorkIns: TWorkflowInstance): boolean;
var
  SQL: string;
  DS: TDataset;
begin
  result := false;
  if Trim(WorkIns.Key) = '' then
    exit;

  CheckDB;
  SQL := Format('SELECT * from %s WHERE %s = :id',
    [WorkInsBindary.TableName, WorkInsBindary.KeyField]);
  FParams.Clear;
  FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkIns.Key);
  DS := OpenQuery(SQL, FParams);
  try
    if not DS.IsEmpty then
    begin
      WorkflowInstanceLoadRecord(DS, WorkIns);
      result := true;
    end;
  finally
    DS.Close;
    if DestroyQueries then
      DS.Free;
  end;
end;

procedure TCustomWorkflowDB.WorkflowInstanceLoadRecord(DS: TDataset;
  WorkIns: TWorkflowInstance);
begin
  With WorkInsBindary do
  begin
    ComponentFromString(WorkIns, DS.FieldByName(WorkflowField).AsString);
  //  WorkIns.Name := WDTable.FieldByName(NameField).AsString;
    WorkIns.Key := DS.FieldByName(KeyField).AsString;
    WorkIns.DefinitionKey := IntToStr(DS.FieldByName(WorkDefKeyField).AsInteger);
  //  WorkIns.Started := WITable.FIeldByName('Started').AsBoolean;
  end;
end;

procedure TCustomWorkflowDB.WorkflowInstanceUpdate(WorkIns: TWorkflowInstance);
var
  SQL: string;
begin
  CheckDB;
  With WorkInsBindary do
  begin
    if WorkIns.Key <> '' then
    begin
      SQL := Format('UPDATE %s SET '+
        '%s = :workflow, '+
        '%s = :workdefkey '+
        'WHERE %s = :id',
        [TableName, WorkflowField, WorkDefKeyField, KeyField]);
      FParams.Clear;
      FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkIns.Key);

      {Save diagram attachments - it must be BEFORE streaming the diagram, because SaveAttachments procedure
       sets the key value for each attachment item. The diagram should be streamed only after a key value
       is assigned and after DirtyContent property is set to false}
      SaveAttachments(WorkIns.Diagram, ptInstance, WorkIns.Key);
      FParams.Clear;
      FParams.CreateParam(ftInteger, 'id', ptInput).AsInteger := StrToInt(WorkIns.Key);
      FParams.CreateParam(ftMemo, 'workflow', ptInput).AsMemo := ComponentToString(WorkIns);

      FParams.CreateParam(ftInteger, 'workdefkey', ptInput).AsInteger := StrToInt(WorkIns.DefinitionKey);
      ExecuteQuery(SQL, FParams);

    end else
      wsDBError(Format(_str(SErrorUpdateEmptyKey), [TableName]));
  end;
end;

procedure TCustomWorkflowDB.SaveAttachments(ADiagram: TWorkflowDiagram;
  AType: TAttachmentParentType; AWorkKey: string);
var
  c: integer;
  d: integer;
  AItem: TAttachmentItem;
  AKeys: string;
  SQL: string;
begin
  for c := 0 to ADiagram.Attachments.Count - 1 do           
    for d := 0 to ADiagram.Attachments[c].Items.Count - 1 do
    begin
      AItem := ADiagram.Attachments[c].Items[d];
      if AItem.DirtyContent then
      begin
        if AItem.Key = '' then
          AttachmentItemInsert(AItem, AType, AWorkKey)
        else
          AttachmentItemUpdate(AItem, AType, AWorkKey);

        {Very important to set DirtyContent to false, so that the content of the attachment
         will not be streamed together with the diagram}
        AItem.DirtyContent := false;
      end;
      if AKeys <> '' then AKeys := AKeys + ', ';
      AKeys := AKeys + AItem.Key;
    end;

  {Delete the non existant attachments}
  FParams.Clear;
  if AKeys = '' then
    AKeys := '-1';
  With AttachmentBindary do
    SQL := Format('Delete from %s Where %s = %s and %s = %d and not (%s in (%s))',
      [TableName, WorkKeyFIeld, AWorkKey, ObjectTypeField, Ord(AType), KeyField, AKeys]);
  ExecuteQuery(SQL, FParams);
end;

procedure TCustomWorkflowDB.AttachmentItemInsert(AItem: TAttachmentItem;
  AType: TAttachmentParentType; AWorkKey: string);
var
  SQL: string;
  CreatedOn: TDateTime;
begin
  CheckDB;
  CreatedOn := Now;
  With AttachmentBindary do
  begin