jcltask.pas

East make Tray Icon in delphi

end;

//=== { TJclTaskTriggers } ===================================================

constructor TJclTaskTriggers.Create(AWorkItem: TJclScheduledWorkItem);
begin
  inherited Create(TJclTaskTrigger);
  FWorkItem := AWorkItem;
end;

function TJclTaskTriggers.GetItem(Index: Integer): TJclTaskTrigger;
begin
  Result := TJclTaskTrigger(inherited GetItem(Index));
end;

procedure TJclTaskTriggers.SetItem(Index: Integer; Value: TJclTaskTrigger);
begin
  inherited SetItem(Index, Value);
end;

function TJclTaskTriggers.GetOwner: TPersistent;
begin
  Result := FWorkItem;
end;

function TJclTaskTriggers.Add(ATrigger: ITaskTrigger): TJclTaskTrigger;
begin
  Result := Add;
  Result.SetTaskTrigger(ATrigger);
end;

function TJclTaskTriggers.Add: TJclTaskTrigger;
begin
  Result := TJclTaskTrigger(inherited Add);
end;

function TJclTaskTriggers.AddItem(Item: TJclTaskTrigger; Index: Integer): TJclTaskTrigger;
begin
  if Item = nil then
    Result := Add
  else
    Result := Item;

  if Assigned(Result) then
  begin
    Result.Collection := Self;
    if Index < 0 then
      Index := Count - 1;
    Result.Index := Index;
  end;
end;

function TJclTaskTriggers.Insert(Index: Integer): TJclTaskTrigger;
begin
  Result := AddItem(nil, Index);
end;

//=== { TJclScheduledWorkItem } ==============================================

constructor TJclScheduledWorkItem.Create(const ATaskName: WideString;
  const AScheduledWorkItem: IScheduledWorkItem);
begin
  inherited Create;
  FScheduledWorkItem := AScheduledWorkItem;
  FTaskName := ATaskName;
  FData := TMemoryStream.Create;
  FTriggers := TJclTaskTriggers.Create(Self);
end;

destructor TJclScheduledWorkItem.Destroy;
begin
  FreeAndNil(FTriggers);
  FreeAndNil(FData);
  inherited Destroy;
end;

procedure TJclScheduledWorkItem.Save;
begin
  OleCheck((FScheduledWorkItem as IPersistFile).Save(nil, True));
end;

procedure TJclScheduledWorkItem.Run;
begin
  OleCheck(FScheduledWorkItem.Run);
end;

procedure TJclScheduledWorkItem.Terminate;
begin
  OleCheck(FScheduledWorkItem.Terminate);
end;

function TJclScheduledWorkItem.GetAccountName: WideString;
var
  AccountName: PWideChar;
begin
  Result := '';
  if IsWinNT then  // ignore this method in Win9x/ME
    try
      OleCheck(FScheduledWorkItem.GetAccountInformation(AccountName));
      Result := AccountName;
      CoTaskMemFree(AccountName);

      if Result = '' then
        Result := GetLocalComputerName + '\' + LocalSystemAccount;
    except
      Result := '';
    end;
end;

procedure TJclScheduledWorkItem.SetAccountInformation(const Name, Password: WideString);
begin
  if IsWinNT then  // ignore this method in Win9x/ME
    if (Name = LocalSystemAccount) or (Name = '') then
      OleCheck(FScheduledWorkItem.SetAccountInformation('', nil))
    else
      OleCheck(FScheduledWorkItem.SetAccountInformation(PWideChar(Name), PWideChar(Password)));
end;

procedure TJclScheduledWorkItem.SetAccountName(const Value: WideString);
begin
  SetAccountInformation(Value, '');
end;

procedure TJclScheduledWorkItem.SetPassword(const Value: WideString);
begin
  SetAccountInformation(GetAccountName, Value);
end;

function TJclScheduledWorkItem.GetComment: WideString;
var
  Comment: PWideChar;
begin
  OleCheck(FScheduledWorkItem.GetComment(Comment));
  Result := Comment;
  CoTaskMemFree(Comment);
end;

procedure TJclScheduledWorkItem.SetComment(const Value: WideString);
begin
  OleCheck(FScheduledWorkItem.SetComment(PWideChar(Value)));
end;

function TJclScheduledWorkItem.GetCreator: WideString;
var
  Creator: PWideChar;
begin
  OleCheck(FScheduledWorkItem.GetCreator(Creator));
  Result := Creator;
  CoTaskMemFree(Creator);
end;

procedure TJclScheduledWorkItem.SetCreator(const Value: WideString);
begin
  OleCheck(FScheduledWorkItem.SetCreator(PWideChar(Value)));
end;

function TJclScheduledWorkItem.GetExitCode: DWORD;
begin
  OleCheck(FScheduledWorkItem.GetExitCode(Result));
end;

function TJclScheduledWorkItem.GetDeadlineMinutes: Word;
var
  Dummy: Word;
begin
  OleCheck(FScheduledWorkItem.GetIdleWait(Result, Dummy));
end;

function TJclScheduledWorkItem.GetIdleMinutes: Word;
var
  Dummy: Word;
begin
  OleCheck(FScheduledWorkItem.GetIdleWait(Dummy, Result));
end;

function TJclScheduledWorkItem.GetMostRecentRunTime: TSystemTime;
begin
  OleCheck(FScheduledWorkItem.GetMostRecentRunTime(Result));
end;

function TJclScheduledWorkItem.GetNextRunTime: TSystemTime;
begin
  OleCheck(FScheduledWorkItem.GetNextRunTime(Result));
end;

function TJclScheduledWorkItem.GetRunTimes(const BeginTime, EndTime: TDateTime): TDateTimeArray;
var
  BeginSysTime, EndSysTime: TSystemTime;
  I, Count: Word;
  TaskTimes: PSystemTime;
begin
  DateTimeToSystemTime(BeginTime, BeginSysTime);
  DateTimeToSystemTime(EndTime, EndSysTime);

  if EndTime = InfiniteTime then
    OleCheck(FScheduledWorkItem.GetRunTimes(@BeginSysTime, nil, Count, TaskTimes))
  else
    OleCheck(FScheduledWorkItem.GetRunTimes(@BeginSysTime, @EndSysTime, Count, TaskTimes));
  try
    SetLength(Result, Count);
    for I := 0 to Count-1 do
    begin
      Result[I] := SystemTimeToDateTime(Windows.PSystemTime(TaskTimes)^);
      Inc(TaskTimes);
    end;
  finally
    CoTaskMemFree(TaskTimes);
  end;
end;

function TJclScheduledWorkItem.GetStatus: TJclScheduledTaskStatus;
var
  Status: HRESULT;
begin
  OleCheck(FScheduledWorkItem.GetStatus(Status));
  case Status of
    SCHED_S_TASK_READY:
      Result := tsReady;
    SCHED_S_TASK_RUNNING:
      Result := tsRunning;
    SCHED_S_TASK_NOT_SCHEDULED:
      Result := tsNotScheduled;
    SCHED_S_TASK_HAS_NOT_RUN:
      Result := tsHasNotRun;
  else
    Result := tsUnknown;
  end;
end;

function TJclScheduledWorkItem.GetErrorRetryCount: Word;
begin
  OleCheck(FScheduledWorkItem.GetErrorRetryCount(Result));
end;

procedure TJclScheduledWorkItem.SetErrorRetryCount(const Value: Word);
begin
  OleCheck(FScheduledWorkItem.SetErrorRetryCount(Value));
end;

function TJclScheduledWorkItem.GetErrorRetryInterval: Word;
begin
  OleCheck(FScheduledWorkItem.GetErrorRetryInterval(Result));
end;

procedure TJclScheduledWorkItem.SetErrorRetryInterval(const Value: Word);
begin
  OleCheck(FScheduledWorkItem.SetErrorRetryInterval(Value));
end;

function TJclScheduledWorkItem.GetFlags: TJclScheduledTaskFlags;
var
  AFlags: DWORD;
  AFlag: TJclScheduledTaskFlag;
begin
  OleCheck(FScheduledWorkItem.GetFlags(AFlags));
  Result := [];
  for AFlag:=Low(TJclScheduledTaskFlag) to High(TJclScheduledTaskFlag) do
    if (AFlags and TaskFlagMapping[AFlag]) = TaskFlagMapping[AFlag] then
      Include(Result, AFlag);
end;

procedure TJclScheduledWorkItem.SetFlags(const Value: TJclScheduledTaskFlags);
var
  AFlags: DWORD;
  AFlag: TJclScheduledTaskFlag;
begin
  AFlags := 0;
  for AFlag:=Low(TJclScheduledTaskFlag) to High(TJclScheduledTaskFlag) do
    if AFlag in Value then
      AFlags := AFlags or TaskFlagMapping[AFlag];
  OleCheck(FScheduledWorkItem.SetFlags(AFlags));
end;

function TJclScheduledWorkItem.GetData: TStream;
var
  Count: Word;
  Buf: PByte;
begin
  FData.Clear;
  Buf := nil;
  OleCheck(FScheduledWorkItem.GetWorkItemData(Count, Buf));
  try
    FData.Write(Buf^, Count);
    FData.Seek(0, soFromBeginning);
  finally
    CoTaskMemFree(Buf);
  end;
  Result := FData;
end;

procedure TJclScheduledWorkItem.SetData(const Value: TStream);
begin
  FData.Clear;
  FData.CopyFrom(Value, 0);
  OleCheck(FScheduledWorkItem.SetWorkItemData(FData.Size, PByte(FData.Memory)));
end;

procedure TJclScheduledWorkItem.Refresh;
var
  I, Count: Word;
  ATrigger: ITaskTrigger;
begin
  OleCheck(FScheduledWorkItem.GetTriggerCount(Count));

  FTriggers.Clear;
  if Count > 0 then
  for I:=0 to Count-1 do
  begin
    OleCheck(FScheduledWorkItem.GetTrigger(I, ATrigger));
    FTriggers.Add(ATrigger);
  end;
end;

function TJclScheduledWorkItem.GetTriggerCount: Integer;
begin
  Result := FTriggers.Count;
end;

function TJclScheduledWorkItem.GetTrigger(const Idx: Integer): TJclTaskTrigger;
begin
  Result := TJclTaskTrigger(FTriggers.Items[Idx]);
end;

//=== { TJclScheduledTask } ==================================================

function TJclScheduledTask.GetApplicationName: WideString;
var
  AppName: PWideChar;
begin
  OleCheck(Task.GetApplicationName(AppName));
  Result := AppName;
  CoTaskMemFree(AppName);
end;

procedure TJclScheduledTask.SetApplicationName(const Value: WideString);
begin
  OleCheck(Task.SetApplicationName(PWideChar(Value)));
end;

function TJclScheduledTask.GetMaxRunTime: DWORD;
begin
  OleCheck(Task.GetMaxRunTime(Result));
end;

procedure TJclScheduledTask.SetMaxRunTime(const Value: DWORD);
begin
  OleCheck(Task.SetMaxRunTime(Value));
end;

function TJclScheduledTask.GetParameters: WideString;
var
  Parameters: PWideChar;
begin
  OleCheck(Task.GetParameters(Parameters));
  Result := Parameters;
  CoTaskMemFree(Parameters);
end;

procedure TJclScheduledTask.SetParameters(const Value: WideString);
begin
  OleCheck(Task.SetParameters(PWideChar(Value)));
end;

function TJclScheduledTask.GetPriority: DWORD;
begin
  OleCheck(Task.GetPriority(Result));
end;

procedure TJclScheduledTask.SetPriority(const Value: DWORD);
begin
  OleCheck(Task.SetPriority(Value));
end;

function TJclScheduledTask.GetTaskFlags: DWORD;
begin
  OleCheck(Task.GetTaskFlags(Result));
end;

procedure TJclScheduledTask.SetTaskFlags(const Value: DWORD);
begin
  OleCheck(Task.SetTaskFlags(Value));
end;

function TJclScheduledTask.GetWorkingDirectory: WideString;
var
  WorkingDir: PWideChar;
begin
  OleCheck(Task.GetWorkingDirectory(WorkingDir));
  Result := WorkingDir;
  CoTaskMemFree(WorkingDir);
end;

procedure TJclScheduledTask.SetWorkingDirectory(const Value: WideString);
begin
  OleCheck(Task.SetWorkingDirectory(PWideChar(Value)));
end;

function TJclScheduledTask.ShowPage(Pages: TJclScheduleTaskPropertyPages): Boolean;
var
  PropPages: array [0..2] of MSTask.HPropSheetPage;
  PropHeader: {CommCtrl.}TPropSheetHeader;
begin
  OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_TASK, True, PropPages[0]));
  OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_SCHEDULE, True, PropPages[1]));
  OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_SETTINGS, True, PropPages[2]));

  FillChar(PropHeader, SizeOf(PropHeader), 0);
  PropHeader.dwSize := SizeOf(PropHeader);
  PropHeader.dwFlags := PSH_DEFAULT or PSH_NOAPPLYNOW;
  PropHeader.phpage := @PropPages;
  PropHeader.nPages := Length(PropPages);
  Result := PropertySheet(PropHeader) > 0;
end;

function TJclScheduledTask.GetTask: ITask;
begin
  Result := ScheduledWorkItem as ITask;
end;

// History:

// $Log: JclTask.pas,v $
// Revision 1.21  2005/03/04 06:40:26  marquardt
// changed overloaded constructors to constructor with default parameter (BCB friendly)
//
// Revision 1.20  2005/02/24 16:34:53  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.19  2005/02/24 07:36:24  marquardt
// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas
//
// Revision 1.18  2004/10/25 08:51:23  marquardt
// PH cleaning
//
// Revision 1.17  2004/10/19 21:26:03  rrossmair
// got rid of MSTaskError unit
//
// Revision 1.16  2004/10/17 21:00:16  mthoma
// cleaning
//
// Revision 1.15  2004/10/08 20:13:03  rrossmair
// replaced JclUnicode routines by JclWideStrings equivalents
//
// Revision 1.14  2004/07/28 18:00:54  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.13  2004/06/16 07:30:31  marquardt
// added tilde to all IFNDEF ENDIFs, inherited qualified
//
// Revision 1.12  2004/06/14 13:05:21  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.11  2004/06/14 11:05:53  marquardt
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
//
// Revision 1.10  2004/06/02 03:23:47  rrossmair
// cosmetic changes in several units (code formatting, help TODOs processed etc.)
//
// Revision 1.9  2004/05/06 23:43:22  rrossmair
// minor improvements
//
// Revision 1.8  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.7  2004/04/26 04:28:16
// - add TaskSchedulerServiceControl
// - some bugfixes for Win9x
//
// Revision 1.6  2004/04/06 04:55:18
// adapt compiler conditions, add log entry
//

end.