cbsenum/CBSEnum_JobProcessor.pas at master · himselfv/cbsenum · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
unit CBSEnum_JobProcessor;
// Runs threaded jobs

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TLogEvent = procedure(const AMessage: string) of object;
  TProcessingThread = class(TThread)
  protected
    FOnLog: TLogEvent;
    procedure Log(const AMessage: string);
  public
    constructor Create;
    property OnLog: TLogEvent read FOnLog write FOnLog;
  end;

  TJobProcessorForm = class(TForm)
    mmLog: TMemo;
    UpdateTimer: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure UpdateTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mmLogChange(Sender: TObject);
  protected
    FThread: TProcessingThread;
    FLogSync: TRtlCriticalSection;
    FNewLogLines: TStringList;
    procedure ProcessingThreadLog(const AMessage: string);
    procedure PostLogEntries;
  public
    procedure Log(const msg: string);
    procedure Process(AJob: TProcessingThread);
    procedure EndProcessing;
  end;

var
  JobProcessorForm: TJobProcessorForm;

implementation

{$R *.dfm}

constructor TProcessingThread.Create;
begin
  inherited Create({Suspended=}true); //always create suspended
end;

procedure TProcessingThread.Log(const AMessage: string);
begin
  if Assigned(FOnLog) then
    FOnLog(AMessage);
end;

procedure TJobProcessorForm.FormCreate(Sender: TObject);
begin
  InitializeCriticalSection(FLogSync);
  FNewLogLines := TStringList.Create;
end;

procedure TJobProcessorForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FNewLogLines);
  DeleteCriticalSection(FLogSync);
end;

procedure TJobProcessorForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := (not Assigned(FThread))
    or (MessageBox(Self.Handle, PChar('The operation is still in progress, do you want to abort it?'),
      PChar('Confirm abort'), MB_ICONQUESTION + MB_YESNO) = ID_YES);
end;

procedure TJobProcessorForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  EndProcessing;
end;

procedure TJobProcessorForm.Process(AJob: TProcessingThread);
begin
  if Assigned(FThread) then
    raise Exception.Create('Operation is still in progress');
  FThread := AJob;
  FThread.OnLog := ProcessingThreadLog;
  FThread.Start;
  UpdateTimer.Enabled := true;
end;

procedure TJobProcessorForm.EndProcessing;
begin
  if Assigned(FThread) then begin
    FThread.Terminate;
    FThread.WaitFor;
    FreeAndNil(FThread);
  end;
  UpdateTimer.Enabled := false;
  PostLogEntries(); //in case there's anything pending
end;

procedure TJobProcessorForm.UpdateTimerTimer(Sender: TObject);
begin
  PostLogEntries;

  if FThread = nil then begin
    UpdateTimer.Enabled := false;
    exit;
  end;

  if FThread.FatalException <> nil then begin
    Log('Fatal exception '+FThread.FatalException.ClassName+': '+Exception(FThread.FatalException).Message);
    EndProcessing();
    exit;
  end;

  if FThread.Finished then
    EndProcessing;
end;

procedure TJobProcessorForm.ProcessingThreadLog(const AMessage: string);
begin
  EnterCriticalSection(FLogSync);
  try
    FNewLogLines.Add(AMessage);
  finally
    LeaveCriticalSection(FLogSync);
  end;
end;

procedure TJobProcessorForm.PostLogEntries;
var line: string;
begin
  EnterCriticalSection(FLogSync);
  try
    mmLog.Lines.BeginUpdate;
    for line in FNewLogLines do
      mmLog.Lines.Add(line);
    FNewLogLines.Clear;
    mmLog.Lines.EndUpdate;
    mmLog.Refresh;
  finally
    LeaveCriticalSection(FLogSync);
  end;
end;

procedure TJobProcessorForm.Log(const msg: string);
begin
  mmLog.Lines.Add(msg);
end;


procedure TJobProcessorForm.mmLogChange(Sender: TObject);
begin
  SendMessage(mmLog.Handle, EM_LINESCROLL, 0, mmLog.Lines.Count);
end;

end.