/jcl/examples/windows/tasks/TaskDemoMain.pas
Pascal | 237 lines | 210 code | 25 blank | 2 comment | 49 complexity | d6dbc28e0fc5ff706a3a48ed37f274e0 MD5 | raw file
Possible License(s): BSD-3-Clause
1unit TaskDemoMain; 2 3{$INCLUDE jcl.inc} 4 5interface 6 7uses 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 9 Dialogs, ComCtrls, Menus, ExtCtrls, OleCtrls, SHDocVw, 10 HTTPProd, HTTPApp; 11 12type 13 TfrmMain = class(TForm) 14 barStatus: TStatusBar; 15 lstTasks: TListView; 16 mnuMain: TMainMenu; 17 mnuFile: TMenuItem; 18 mnuFileExit: TMenuItem; 19 mnuPopup: TPopupMenu; 20 popTaskProp: TMenuItem; 21 mnuTask: TMenuItem; 22 mnuTaskProp: TMenuItem; 23 SplitterV: TSplitter; 24 WebBrowser: TWebBrowser; 25 ppTaskInfo: TPageProducer; 26 popTaskAdd: TMenuItem; 27 popTaskDelete: TMenuItem; 28 popLine0: TMenuItem; 29 mnuTaskAdd: TMenuItem; 30 mnuTaskDelete: TMenuItem; 31 mnuTaskLine0: TMenuItem; 32 mnuTaskLine2: TMenuItem; 33 mnuTaskRefresh: TMenuItem; 34 popLine2: TMenuItem; 35 popTaskRefresh: TMenuItem; 36 mnuTaskLine1: TMenuItem; 37 mnuTaskRun: TMenuItem; 38 mnuTaskStop: TMenuItem; 39 popLine1: TMenuItem; 40 popTaskRun: TMenuItem; 41 popTaskStop: TMenuItem; 42 procedure FormCreate(Sender: TObject); 43 procedure WebBrowserDocumentComplete(Sender: TObject; 44 const pDisp: IDispatch; var URL: OleVariant); 45 procedure lstTasksSelectItem(Sender: TObject; Item: TListItem; 46 Selected: Boolean); 47 procedure ppTaskInfoHTMLTag(Sender: TObject; Tag: TTag; 48 const TagString: String; TagParams: TStrings; 49 var ReplaceText: String); 50 procedure FormDestroy(Sender: TObject); 51 private 52 FWebBrowserInitialized: Boolean; 53 54 function SystemTimeToString(const SysTime: TSystemTime): string; 55 function MsToStr(const MsTime: DWORD): string; 56 57 procedure SetHtml(const wb: TWebBrowser; const Html: string); 58 procedure OnRefresh(Sender: TObject); 59 public 60 procedure Refresh; 61 end; 62 63var 64 frmMain: TfrmMain; 65 66implementation 67 68uses ActiveX, ComObj, TypInfo, MsHtml, TaskDemoDataModule, JclTask; 69 70{$R *.dfm} 71 72procedure TfrmMain.FormCreate(Sender: TObject); 73begin 74 FWebBrowserInitialized := False; 75 76 WebBrowser.Navigate('about:blank'); 77 78 Refresh; 79 80 DM.OnRefresh := OnRefresh; 81end; 82 83procedure TfrmMain.FormDestroy(Sender: TObject); 84begin 85 DM.OnRefresh := nil; 86end; 87 88procedure TfrmMain.Refresh; 89var 90 I: Integer; 91begin 92 lstTasks.Clear; 93 for I:=0 to DM.Task.TaskCount-1 do 94 with lstTasks.Items.Add, DM.Task[I] do 95 begin 96 Caption := TaskName; 97 Data := DM.Task[I]; 98 SubItems.Add(SystemTimeToString(MostRecentRunTime)); 99 SubItems.Add(SystemTimeToString(NextRunTime)); 100 SubItems.Add(Comment); 101 end; 102end; 103 104function TfrmMain.SystemTimeToString(const SysTime: TSystemTime): string; 105begin 106 if SysTime.wYear = 0 then 107 Result := 'Never' 108 else 109 Result := DateTimeToStr(SystemTimeToDateTime(SysTime)); 110end; 111 112function TfrmMain.MsToStr(const MsTime: DWORD): string; 113var 114 RealTime: TDateTime; 115begin 116 RealTime := MsTime / MSecsPerDay; 117 Result := IntToStr(Trunc(RealTime)) + ' days ' + TimeToStr(RealTime); 118end; 119 120procedure TfrmMain.SetHtml(const wb: TWebBrowser; const Html: string); 121var 122 Stream: TStream; 123 Adapter: TStreamAdapter; 124 psi: IPersistStreamInit; 125begin 126 Stream := TStringStream.Create(Html); 127 try 128 Adapter := TStreamAdapter.Create(Stream); 129 psi := wb.Document as IPersistStreamInit; 130 OleCheck(psi.InitNew); 131 OleCheck(psi.Load(Adapter)); 132 finally 133 FreeAndNil(Stream); 134 end; 135end; 136 137procedure TfrmMain.OnRefresh(Sender: TObject); 138begin 139 Refresh; 140end; 141 142procedure TfrmMain.WebBrowserDocumentComplete(Sender: TObject; 143 const pDisp: IDispatch; var URL: OleVariant); 144begin 145 if not FWebBrowserInitialized then 146 begin 147 FWebBrowserInitialized := True; 148 149 (((pDisp as IWebBrowser2).Document as IHTMLDocument2).body as IHTMLBodyElement).scroll := 'no'; 150 end; 151end; 152 153procedure TfrmMain.lstTasksSelectItem(Sender: TObject; Item: TListItem; 154 Selected: Boolean); 155begin 156 if Selected and Assigned(Item) then 157 SetHtml(WebBrowser, ppTaskInfo.Content); 158end; 159 160procedure TfrmMain.ppTaskInfoHTMLTag(Sender: TObject; Tag: TTag; 161 const TagString: String; TagParams: TStrings; var ReplaceText: String); 162 function TaskStatusToString(const Status: TJclScheduledTaskStatus): string; 163 const 164 StatusName: array[TJclScheduledTaskStatus] of string = 165 ('Unknown', 'Ready', 'Running', 'Not Scheduled', 'Has Not Run'); 166 begin 167 Result := StatusName[Status]; 168 end; 169 function TaskFlagsToString(const Flags: TJclScheduledTaskFlags): string; 170 var 171 AFlag: TJclScheduledTaskFlag; 172 begin 173 for AFlag:=Low(TJclScheduledTaskFlag) to High(TJclScheduledTaskFlag) do 174 if AFlag in Flags then 175 Result := Result + GetEnumName(TypeInfo(TJclScheduledTaskFlag), Integer(AFlag)) + ' '; 176 if Result = '' then 177 Result := 'Empty'; 178 end; 179 function TriggersToHtml(const Task: TJclScheduledTask): string; 180 var 181 I: Integer; 182 begin 183 for I:=0 to Task.TriggerCount-1 do 184 Result := Format('%s<LI>%s</LI>', [Result, Task.Triggers[I].TriggerString]); 185 Result := '<UL>' + Result + '</UL>'; 186 end; 187begin 188 with TJclScheduledTask(frmMain.lstTasks.Selected.Data) do 189 try 190 if CompareText(TagString, 'TaskName') = 0 then 191 ReplaceText := TaskName 192 else if CompareText(TagString, 'AccountName') = 0 then 193 ReplaceText := AccountName 194 else if CompareText(TagString, 'Comment') = 0 then 195 ReplaceText := Comment 196 else if CompareText(TagString, 'Creator') = 0 then 197 ReplaceText := Creator 198 else if CompareText(TagString, 'ErrorRetryCount') = 0 then 199 ReplaceText := 'Unimplemented' // IntToStr(ErrorRetryCount) 200 else if CompareText(TagString, 'ErrorRetryInterval') = 0 then 201 ReplaceText := 'Unimplemented' // IntToStr(ErrorRetryInterval) 202 else if CompareText(TagString, 'ExitCode') = 0 then 203 ReplaceText := IntToStr(ExitCode) 204 else if CompareText(TagString, 'Data') = 0 then 205 ReplaceText := IntToStr(OwnerData.Size) + ' Bytes' 206 else if CompareText(TagString, 'IdleMinutes') = 0 then 207 ReplaceText := IntToStr(IdleMinutes) + ' Minutes' 208 else if CompareText(TagString, 'DeadlineMinutes') = 0 then 209 ReplaceText := IntToStr(DeadlineMinutes) + ' Minutes' 210 else if CompareText(TagString, 'MostRecentRunTime') = 0 then 211 ReplaceText := SystemTimeToString(MostRecentRunTime) 212 else if CompareText(TagString, 'NextRunTime') = 0 then 213 ReplaceText := SystemTimeToString(NextRunTime) 214 else if CompareText(TagString, 'Status') = 0 then 215 ReplaceText := TaskStatusToString(Status) 216 else if CompareText(TagString, 'Flags') = 0 then 217 ReplaceText := TaskFlagsToString(Flags) 218 else if CompareText(TagString, 'ApplicationName') = 0 then 219 ReplaceText := ApplicationName 220 else if CompareText(TagString, 'WorkingDirectory') = 0 then 221 ReplaceText := WorkingDirectory 222 else if CompareText(TagString, 'MaxRunTime') = 0 then 223 ReplaceText := MsToStr(MaxRunTime) 224 else if CompareText(TagString, 'Parameters') = 0 then 225 ReplaceText := Parameters 226 else if CompareText(TagString, 'Priority') = 0 then 227 ReplaceText := IntToStr(Priority) 228 else if CompareText(TagString, 'TaskFlags') = 0 then 229 ReplaceText := IntToHex(TaskFlags, 8) 230 else if CompareText(TagString, 'Triggers') = 0 then 231 ReplaceText := TriggersToHtml(TJclScheduledTask(frmMain.lstTasks.Selected.Data)); 232 except 233 ReplaceText := 'Unknown'; 234 end; 235end; 236 237end.