wsclasses.pas

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

function TAttachmentItems.AddFile(AFileName: string): TAttachmentItem;
var
  NewName: string;
begin
  result := nil;
  if FileExists(AFileName) then
  begin
    NewName := ExtractFileName(AFileName);
    result := FindByName(NewName);
    if result = nil then
      result := Add;
    begin
      try
        result.OriginalName := AFileName;        
        result.Name := NewName;
        result.LoadContentFromFile(AFileName);
      except
        result.free;
        raise;
      end;
    end;
  end;
end;

constructor TAttachmentItems.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TAttachmentItem);
end;

function TAttachmentItems.FindByName(AName: string): TAttachmentItem;
var
  c: integer;
begin
  result := nil;
  for c := 0 to Count - 1 do
    if SameText(AName, Items[c].Name) then
    begin
      result := Items[c];
      break;
    end;
end;

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

{ TAttachmentItem }

procedure TAttachmentItem.Assign(Source: TPersistent);
begin
  if Source is TAttachmentItem then
  begin
    FName := TAttachmentItem(Source).FName;
    //FExtension := TAttachmentItem(Source).FExtension;
    FOriginalName := TAttachmentItem(Source).FOriginalName;
    FKey := TAttachmentItem(Source).FKey;

    {Assing dirty content and content too so that it saves correctly}
    FDirtyContent := TAttachmentItem(Source).FDirtyContent;
    FContent := TAttachmentItem(Source).FContent;
  end else
    inherited Assign(Source);
end;

constructor TAttachmentItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FDirtyContent := false;
end;

destructor TAttachmentItem.Destroy;
begin
  if FNotifyThread <> nil then
    TerminateThread(FNotifyThread.Handle, 0); 
  FNotifyThread := nil;
  inherited;
end; 

function TAttachmentItem.GetContent: string;
begin
  if not FDirtyContent then
    WorkflowStudio.WorkflowDB.AttachmentItemLoad(Self);
  result := FContent;
end;

function TAttachmentItem.GetExtension: string;
begin
  result := ExtractFileExt(Name);
end;

function TAttachmentItem.IsContentStored: Boolean;
begin
  {Content property will only be saved when the file content is in memory (not saved in database,
   or different from database). So FDirtyContent true means that the content of the attachment
   was changed in memory. If FDirtyContent is false, the file is in database so there is no need
   to be persisted. COntent published property should be only streamed for memory-assignment purposes}
  result := FDirtyContent;
end;

procedure TAttachmentItem.LoadContentFromFile(AFileName: string);
var
  FS: TFileStream;
  SS: TStringStream;
begin
  FS := TFileStream.Create(AFileName, fmOpenRead);
  SS := TStringStream.Create('');
  try
    SS.CopyFrom(FS, FS.Size);
    SS.Position := 0;
    SetContent(SS.DataString);
  finally
    SS.Free;
    FS.Free;
  end;
end;

procedure TAttachmentItem.Open(AllowEdit: boolean; APath: string = '');
var
  Buffer: string;
  FullName: string;
begin
  {Get windows temporary path if APath is empty}
  if APath = '' then
  begin
    SetLength(Buffer, MAX_PATH);
    SetLength(Buffer, GetTempPath(MAX_PATH, PChar(Buffer)));
    APath := Buffer;
  end;

  ForceDirectories(APath);

  if (Length(APath) > 0) and (APath[Length(APath)] <> '\') then
    APath := APath + '\';

  FullName := APath + Name;

  SaveContentToFile(FullName);
  DoShellOpen(FullName, AllowEdit);
end;

procedure TAttachmentItem.DoShellOpen(AFileName: string; AllowEdit: boolean);
var
  EditEvent: TNotifyEvent;
begin
  if FNotifyThread = nil then
  begin
    if AllowEdit then
      EditEvent := ShellAppClosed
    else
      EditEvent := nil;

    FNotifyThread := TNotifyThread.Create(Self, AFileName, EditEvent);
  end else
    raise EWorkflowException.Create(_str(SErrorFileAlreadyOpen));
end;

procedure TAttachmentItem.ShellAppClosed(Sender: TObject);
var
  AFileAge: TDateTime;
begin
  if (FNotifyThread <> nil) and FileExists(FNotifyThread.FFileName) then
  begin
    {$IFDEF DELPHI2006_LVL}
    FileAge(FNotifyThread.FFileName, AFileAge);
    {$ELSE}
    AFileAge := FileDateToDateTime(FileAge(FNotifyThread.FFileName));
    {$ENDIF}
    if FNotifyThread.FFileAge <> AFileAge then
    begin
      if MessageDlg(Format(_str(SConfirmUpdateModifiedAttachment),
        [FNotifyThread.FFileName]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      begin
        LoadContentFromFile(FNotifyThread.FFileName);
      end;
    end;
  end;
end;

procedure TAttachmentItem.CursorDefault;
begin
  Screen.Cursor := FSaveCursor;
end;

procedure TAttachmentItem.CursorHourGlass;
begin
  FSaveCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
end;

{ TNotifyThread }

constructor TNotifyThread.Create(AItem: TAttachmentItem;
  const FileName: string; OnClosed: TNotifyEvent);
begin
  inherited Create(True);
  FItem := AItem;
  if FileExists(FileName) then
    {$IFDEF DELPHI2006_LVL}
    FileAge(FileName, FFileAge);
    {$ELSE}
    FFileAge := FileDateToDateTime(FileAge(FileName));
    {$ENDIF}
  FreeOnTerminate := True;
  OnTerminate := OnClosed;
  FFileName := FileName;
  Resume;
end;

destructor TNotifyThread.Destroy;
begin
  if FItem <> nil then
    FItem.FNotifyThread := nil;
  inherited;
end;

procedure TNotifyThread.Execute;
var
  se: SHELLEXECUTEINFO;
  ok: boolean;
begin
  with se do
  begin
    {$WARNINGS OFF}
    cbSize := SizeOf(SHELLEXECUTEINFO);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    lpVerb := 'open';
    lpFile := PChar(FFileName);
    lpParameters := nil;
    lpDirectory := PChar(ExtractFilePath(ParamStr(0)));
    nShow := SW_SHOW;
    {$WARNINGS ON}
  end;

  if FItem <> nil then
    Synchronize(FItem.CursorHourGlass);
  try
    {$WARNINGS OFF}
    ok := ShellExecuteEx(@se);
    {$WARNINGS ON}
  finally
    if FItem <> nil then
      Synchronize(FItem.CursorDefault);
  end;

  if ok then
  begin
    WaitForSingleObject(se.hProcess, INFINITE);
    if se.hProcess <> 0 then
      CloseHandle(se.hProcess);
  end;
end;

procedure TAttachmentItem.SaveContentToFile(AFileName: string);
var
  FS: TFileStream;
  SS: TStringStream;
begin
  FS := TFileStream.Create(AFileName, fmCreate);
  SS := TStringStream.Create(GetContent);
  try
    SS.Position := 0;
    FS.CopyFrom(SS, SS.Size);
  finally
    SS.Free;
    FS.Free;
  end;
end;

procedure TAttachmentItem.SetContent(const Value: string);
begin
  FContent := Value;
  FDirtyContent := true;
end;

{ TTaskDefinitions }

function TTaskDefinitions.Add: TTaskDefinition;
begin
  result := TTaskDefinition(inherited Add);
end;

constructor TTaskDefinitions.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TTaskDefinition);
end;

function TTaskDefinitions.FindByName(AName: string): TTaskDefinition;
var
  c: integer;
begin
  result := nil;
  for c := 0 to Count - 1 do
    if SameText(AName, Items[c].Name) then
    begin
      result := Items[c];
      break;
    end;
end;

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

function TTaskDefinitions.GetOwner: TPersistent;
begin
  result := inherited GetOwner;
end;

{ TTaskDefinition }

procedure TTaskDefinition.Assign(Source: TPersistent);
begin
  if Source is TTaskDefinition then
  begin
    FKey := TTaskDefinition(Source).FKey;
    FName := TTaskDefinition(Source).FName;
    FSubject := TTaskDefinition(Source).FSubject;
    FDescription := TTaskDefinition(Source).FDescription;
    FAssignmentRule := TTaskDefinition(Source).FAssignmentRule;
    FStatusList.Assign(TTaskDefinition(Source).FStatusList);
    FTaskInstanceKeys.Assign(TTaskDefinition(Source).FTaskInstanceKeys);
    FPreviousTaskInsKeys.Assign(TTaskDefinition(Source).FPreviousTaskInsKeys);
    FShowAttachments := TTaskDefinition(Source).FShowAttachments;
    FAttachmentPermissions := TTaskDefinition(Source).FAttachmentPermissions;
    FMailNotification := TTaskDefinition(Source).FMailNotification;
    FFields.Assign(TTaskDefinition(Source).FFields);
  end else
    inherited Assign(Source);
end;

constructor TTaskDefinition.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FShowAttachments := true;
  FAttachmentPermissions := [];
  FStatusList := TStringList.Create;
  FTaskInstanceKeys := TStringList.Create;
  FPreviousTaskInsKeys := TStringList.Create;
  FFields := TTaskFields.Create(Self, TTaskField);
end;

destructor TTaskDefinition.Destroy;
begin
  FFields.Free;
  FTaskInstanceKeys.Free;
  FPreviousTaskInsKeys.Free;
  FStatusList.Free;
  inherited;
end;

procedure TTaskDefinition.FillStatusList(AList: TStrings);
var
  c: integer;
  S: string;
begin
  AList.Clear;
  for c := 0 to StatusList.Count - 1 do
  begin
    S := StatusList[c];
    if (Length(S) > 0) and (S[1] = '*') then
      S := Copy(S, 2, Length(S));
    AList.Add(S);
  end;
end;

function TTaskDefinition.GetInitialStatus: string;
var
  c: integer;
begin
  result := '';
  c := 0;
  while c < StatusList.Count do
  begin
    if not IsCompletionStatus(StatusList[c]) then
    begin
      result := StatusList[c];
      break;
    end else
      inc(c);
  end;
end;

function TTaskDefinition.IsCompletionStatus(AStatus: string): boolean;
var
  c: integer;
begin
  result := false;
  for c := 0 to StatusList.Count - 1 do
    if (Length(StatusList[c]) > 0) and (StatusList[c][1] = '*') then
    begin
      if SameText(Copy(StatusList[c], 2, MaxInt), AStatus) then
      begin
        result := true;
        exit;
      end;
    end;
end;

procedure TTaskDefinition.SetStatusList(const Value: TStrings);
begin
  FStatusList := Value;
end;

(*{ TTaskInstances }

function TTaskInstances.Add: TTaskInstance;
begin
  result := TTaskInstance(inherited Add);
end;

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

function TTaskInstances.GetItem(Index: integer): TTaskInstance;
begin
  result := TTaskInstance(inherited Items[Index]);
end;*)

procedure TTaskDefinition.SetFields(const Value: TTaskFields);
begin
  FFields.Assign(Value);
end;

{ TTaskInstance }

function TTaskInstance.CanUpdate(AUserId: string): boolean;
begin
  result := WorkflowStudio.UserManager.IsSameUser(AUserId, Self.UserId) or
    WorkflowStudio.UserManager.BelongsToGroup(AUserId, Self.UserId);
end;

constructor TTaskInstance.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FContainer := TDataModule.Create(nil);
  FDiagram := TLiveDiagram.Create(FContainer);
  FTaskDef := TTaskDefinition.Create(nil);
end;

destructor TTaskInstance.Destroy;
begin
  FContainer.Free;
  FContainer := nil;
  FDiagram := nil;
  FTaskDef.Free;
  inherited;
end;

function TTaskInstance.GetCompleted: boolean;
begin
  result := IsCompletionStatus(Status);
end;

function TTaskInstance.IsCompletionStatus(AStatus: string): boolean;
begin
  result := TaskDef.IsCompletionStatus(AStatus);
end;

procedure TTaskInstance.SetTaskDef(const Value: TTaskDefinition);
begin
  FTaskDef.Assign(Value);
end;

{ TTaskInstanceList }

function TTaskInstanceList.Add: TTaskInstanceItem;
begin
  result := TTaskInstanceItem(inherited Add);
end;

function TTaskInstanceList.GetItem(index: integer): TTaskInstanceItem;
begin
  result := TTaskInstanceItem(inherited Items[Index]);
end;

{ TTaskInstanceItem }

constructor TTaskInstanceItem.Create(Collection: TCollection);
begin
  inherited;
  FTask := TTaskInstance.Create(nil);
end;

destructor TTaskInstanceItem.Destroy;
begin
  FTask.Free;
  inherited;
end;

{ TTaskField }

procedure TTaskField.Assign(Source: TPersistent);
begin
  if Source is TTaskField then
  begin
    FCaption := TTaskField(Source).FCaption;
    FReadOnly := TTaskField(Source).FReadOnly;
    FRequired := TTaskField(Source).FRequired;
    FWorkflowVarName := TTaskField(Source).FWorkflowVarName;
  end else
    inherited Assign(Source);
end;

{ TTaskFields }

function TTaskFields.Add: TTaskField;
begin
  result := TTaskField(inherited Add);
end;

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