Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:The basic concept appears to be working.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:ba21d176e135d092469621c4fe509d6c849ab235
User & Date: tinus 2017-02-10 23:37:27
Context
2017-02-10
23:41
Added (very) basic readme. check-in: 722df1cd28 user: tinus tags: trunk
23:37
The basic concept appears to be working. check-in: ba21d176e1 user: tinus tags: trunk
12:40
First commit. Adding/removing folder works in UI. check-in: f51b9be69b user: tinus tags: trunk
Changes

Changes to src/FMain.dfm.

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
..
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
..
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
...
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
object frmFolderWatcher: TfrmFolderWatcher
  Left = 0
  Top = 0
  Caption = 'Folder Watcher'
  ClientHeight = 402
  ClientWidth = 676
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False


  PixelsPerInch = 96
  TextHeight = 13
  object splFoldersDetails: TSplitter
    Left = 256
    Top = 28
    Height = 374
    ResizeStyle = rsUpdate
  end
  object lvwFolders: TListView
    AlignWithMargins = True
    Left = 3
    Top = 31
    Width = 250
    Height = 368
    Align = alLeft
    BevelInner = bvNone
    BevelOuter = bvNone
    Checkboxes = True
    Columns = <
      item
        Caption = 'Folder'

      end>
    FlatScrollBars = True
    HideSelection = False
    MultiSelect = True
    ReadOnly = True
    RowSelect = True

    SmallImages = imlIcons
    TabOrder = 0
    ViewStyle = vsList
    OnSelectItem = lvwFoldersSelectItem
    OnItemChecked = lvwFoldersItemChecked
  end
  object pnlDetails: TPanel
    Left = 259
    Top = 28
    Width = 417
    Height = 374
    Align = alClient
    BevelOuter = bvNone
    TabOrder = 1
  end
  object clbrMain: TCoolBar
    Left = 0
    Top = 0
................................................................................
    AutoSize = True
    BandBorderStyle = bsNone
    Bands = <
      item
        Control = acttbFolders
        ImageIndex = -1
        MinHeight = 26
        Width = 215
      end
      item
        Break = False
        Control = acttbWatchers
        ImageIndex = -1

        Width = 457
      end>

    EdgeBorders = [ebBottom]

    object acttbFolders: TActionToolBar
      Left = 11
      Top = 0
      Width = 202
      Height = 26
      ActionManager = actmgrMain
      Caption = 'Folders'
      Color = clMenuBar
      ColorMap.DisabledFontColor = 7171437
      ColorMap.HighlightColor = clWhite
      ColorMap.BtnSelectedFont = clBlack
      ColorMap.UnusedColor = clWhite
      Font.Charset = DEFAULT_CHARSET
................................................................................
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      Spacing = 0
    end
    object acttbWatchers: TActionToolBar
      Left = 228
      Top = 0
      Width = 448
      Height = 25
      ActionManager = actmgrMain
      Caption = 'Watchers'
      Color = clMenuBar
      ColorMap.DisabledFontColor = 7171437
      ColorMap.HighlightColor = clWhite
      ColorMap.BtnSelectedFont = clBlack
      ColorMap.UnusedColor = clWhite
      Font.Charset = DEFAULT_CHARSET
................................................................................
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      Spacing = 0
    end
  end
  object actmgrMain: TActionManager





    ActionBars = <
      item


      end
      item
        Items = <
          item
            Action = actFolderRemove
            Caption = '&Remove folder'

          end>
      end
      item
        Items = <
          item
            Action = actFolderAdd
            ImageIndex = 0

          end
          item
            Action = actFolderRemove
            Caption = '&Remove folder'
            ImageIndex = 1
          end>
        ActionBar = acttbFolders
      end
      item
        ActionBar = acttbWatchers

      end>





    Images = imlMain
    Left = 32
    Top = 136
    StyleName = 'Platform Default'
    object actFolderAdd: TBrowseForFolder
      Category = 'Folder'
      Caption = 'Add folder...'
      DialogCaption = 'Select folder to watch'
      BrowseOptions = [bifEditBox, bifNewDialogStyle, bifReturnOnlyFSDirs, bifUseNewUI]
      BrowseOptionsEx = [bifeAllowMultiselect]
      ImageIndex = 0
      OnAccept = actFolderAddAccept
    end
    object actFolderRemove: TAction
      Category = 'Folder'
      Caption = 'Remove folder'
      Enabled = False
      ImageIndex = 1
      OnExecute = actFolderRemoveExecute
    end
  end
  object imlMain: TImageList
    ColorDepth = cd32Bit
    Left = 96
    Top = 136
    Bitmap = {
      494C0101020008000C0010001000FFFFFFFF2100FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000400000001000000001002000000000000010
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000465D4E88216A
      3CF2166834FF216A3CF2465D4E88000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000045526A781D4E
      A8DF0340BAFE1A4EABE33F4F697A000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000455B4D84258B50FF61B9
      8CFF94D2B1FF61B98CFF258B50FF465E4F8C0000000000000000000000000000
      00000000000000000000000000000000000000000000465570802663C7FB1E74
      E6FF0376EAFF0061DDFF054BBBFC3F4F697A0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000465868704C7395A63784
      C9EA3087D2F73087D2F73087D2F73087D2F73087D2F7196A3BFF5FB98AFF5DB9
      86FFFFFFFFFF5DB886FF64BB8EFF1D6A39F700000000465868704C7395A63784
      C9EA3087D2F73087D2F73087D2F73087D2F73087D2F7064ABAFE609CF4FF157C
      FFFF0073F8FF0073EEFF0165E1FF194DABE40000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003D89C6E6D1E1EBF0A6DB
      F2FD9DDBF4FF95DAF3FF8DD8F3FF85D7F3FF7CD4F2FF2E7849FF9BD4B5FFFFFF
      FFFFFFFFFFFFFFFFFFFF94D2B1FF166834FF000000003D89C6E6D1E1EBF0A6DB
      F2FD9DDBF4FF95DAF3FF8DD8F3FF85D7F3FF7CD4F2FF0240BBFFADCDFEFFFFFF
      FFFFFFFFFFFFFFFFFFFF157CEFFF0340BAFE0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003791D4F7EFFAFEFFA0E9
      F9FF90E5F8FF80E1F7FF6FDEF6FF60DAF5FF51D7F4FF41885FFF8FD3B0FF91D6
      B0FFFFFFFFFF62BB8BFF64BB8EFF1D6A39F7000000003791D4F7EFFAFEFFA0E9
      F9FF90E5F8FF80E1F7FF6FDEF6FF60DAF5FF51D7F4FF0A54C0FF8CB4F6FF4A91
      FFFF0F74FFFF1E85FFFF3D89EBFF1E4EA8DE0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003898D5F8F2FAFDFFB2ED
      FAFFA3E9F9FF94E6F8FF84E2F7FF73DEF6FF62DBF5FF51B2ADFF5EAA80FF94D4
      B3FFB9E6D0FF67BA8EFF2A8E54FF465E4F8C000000003898D5F8F2FAFDFFB2ED
      FAFFA3E9F9FF94E6F8FF84E2F7FF73DEF6FF62DBF5FF399ADEFF3572D2FF8CB4
      F7FFB7D6FEFF6FA7F5FF2A69CBFF3F4A606D0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000379ED5F9F6FCFEFFC8F2
      FCFFB8EFFBFFABECFAFF9BE8F9FF8AE3F7FF79E0F6FF69DCF6FF58B6B3FF5596
      72FF4C8D63FF44895EFF328B91FB0000000000000000379ED5F9F6FCFEFFC8F2
      FCFFB8EFFBFFABECFAFF9BE8F9FF8AE3F7FF79E0F6FF69DCF6FF3C9BDEFF135A
      C5FF0240BBFF1756C0FF1E71C8FB000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000037A4D5FAFEFFFFFFF8FD
      FFFFF6FDFFFFF5FCFFFFF3FCFEFFD8F6FCFF93E6F8FF84E3F7FF73DFF6FF65DB
      F5FF59D8F4FFD7F4FCFF37A1D4F7000000000000000037A4D5FAFEFFFFFFF8FD
      FFFFF6FDFFFFF5FCFFFFF3FCFEFFD8F6FCFF93E6F8FF84E3F7FF73DFF6FF65DB
      F5FF59D8F4FFD7F4FCFF37A1D4F7000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000035A7D5FAE8F6FBFF93D4
      EFFF87CEEEFF70C0E9FFC9E9F6FFF2FCFEFFF3FCFEFFF2FCFEFFF0FCFEFFEFFB
      FEFFEEFBFEFFFEFFFFFF38A6D4F7000000000000000035A7D5FAE8F6FBFF93D4
      EFFF87CEEEFF70C0E9FFC9E9F6FFF2FCFEFFF3FCFEFFF2FCFEFFF0FCFEFFEFFB
      FEFFEEFBFEFFFEFFFFFF38A6D4F7000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003BA4D0F2F1FAFDFF93DE
      F5FF92DCF4FF80D5F2FF67CAEDFF69CBEAFF84D3EFFF7DD2EFFF77D0EFFF73CF
      EEFF6FCFEEFFE9F7FBFF38A8D0F300000000000000003BA4D0F2F1FAFDFF93DE
      F5FF92DCF4FF80D5F2FF67CAEDFF69CBEAFF84D3EFFF7DD2EFFF77D0EFFF73CF
      EEFF6FCFEEFFE9F7FBFF38A8D0F3000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003BA8CFF0F7FCFEFF8DE4
      F8FF90DEF5FF9EE0F5FFABE1F6FFEFFBFEFFF4FDFEFFF3FCFEFFF1FCFEFFEFFB
      FEFFEEFBFEFFF4F7F9F9479BBAD400000000000000003BA8CFF0F7FCFEFF8DE4
      F8FF90DEF5FF9EE0F5FFABE1F6FFEFFBFEFFF4FDFEFFF3FCFEFFF1FCFEFFEFFB
      FEFFEEFBFEFFF4F7F9F9479BBAD4000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000038AFD5F8FDFEFEFFFEFF
      FFFFFEFEFFFFFDFEFFFFFEFFFFFFEAF7FBFF6AC3DEF969C2DCF869C2DCF869C2
      DCF876C7DEF773B7CCE13E4C5156000000000000000038AFD5F8FDFEFEFFFEFF
      FFFFFEFEFFFFFDFEFFFFFEFFFFFFEAF7FBFF6AC3DEF969C2DCF869C2DCF869C2
      DCF876C7DEF773B7CCE13E4C5156000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000479DB6D05CBEDCFA5EBF
      DDFA5EBFDDFA5EBFDDFA5DBFDDFA48A5C1DD141515160E0E0E0F0E0E0E0F0E0E
      0E0F0E0E0E0F0E0E0E0F030303040000000000000000479DB6D05CBEDCFA5EBF
      DDFA5EBFDDFA5EBFDDFA5DBFDDFA48A5C1DD141515160E0E0E0F0E0E0E0F0E0E
      0E0F0E0E0E0F0E0E0E0F03030304000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000424D3E000000000000003E000000
      2800000040000000100000000100010000000000800000000000000000000000
      000000000000000000000000FFFFFF00FFC1FFC100000000FF80FF8000000000
      8000800000000000800080000000000080008000000000008000800000000000
      8001800100000000800180010000000080018001000000008001800100000000
      800180010000000080018001000000008001800100000000FFFFFFFF00000000
      FFFFFFFF00000000FFFFFFFF00000000}
  end
  object imlIcons: TImageList
    Left = 152
    Top = 136
  end
end




|








>
>





|







|







>






>


|







|







 







|





>
|

>

>



|

|







 







|
|
|
|
|







 







|
>
>
>
>
>
|

>
>


<
<
<
|
>
|
<

<
<
|
<
>
|
|
<
|
<
|
<


<
>

>
>
>
>
>
|
|
<
<
<
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




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
..
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
..
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
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














































































































































162
163
164
165
object frmFolderWatcher: TfrmFolderWatcher
  Left = 0
  Top = 0
  Caption = 'Folder Watcher'
  ClientHeight = 452
  ClientWidth = 676
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object splFoldersDetails: TSplitter
    Left = 256
    Top = 28
    Height = 274
    ResizeStyle = rsUpdate
  end
  object lvwFolders: TListView
    AlignWithMargins = True
    Left = 3
    Top = 31
    Width = 250
    Height = 268
    Align = alLeft
    BevelInner = bvNone
    BevelOuter = bvNone
    Checkboxes = True
    Columns = <
      item
        Caption = 'Folder'
        Width = 200
      end>
    FlatScrollBars = True
    HideSelection = False
    MultiSelect = True
    ReadOnly = True
    RowSelect = True
    ShowColumnHeaders = False
    SmallImages = imlIcons
    TabOrder = 0
    ViewStyle = vsReport
    OnSelectItem = lvwFoldersSelectItem
    OnItemChecked = lvwFoldersItemChecked
  end
  object pnlDetails: TPanel
    Left = 259
    Top = 28
    Width = 417
    Height = 274
    Align = alClient
    BevelOuter = bvNone
    TabOrder = 1
  end
  object clbrMain: TCoolBar
    Left = 0
    Top = 0
................................................................................
    AutoSize = True
    BandBorderStyle = bsNone
    Bands = <
      item
        Control = acttbFolders
        ImageIndex = -1
        MinHeight = 26
        Width = 620
      end
      item
        Break = False
        Control = acttbWatchers
        ImageIndex = -1
        MinHeight = 23
        Width = 52
      end>
    Color = clMenuBar
    EdgeBorders = [ebBottom]
    ParentColor = False
    object acttbFolders: TActionToolBar
      Left = 11
      Top = 0
      Width = 607
      Height = 26
      ActionManager = modActions.actmgrMain
      Caption = 'Folders'
      Color = clMenuBar
      ColorMap.DisabledFontColor = 7171437
      ColorMap.HighlightColor = clWhite
      ColorMap.BtnSelectedFont = clBlack
      ColorMap.UnusedColor = clWhite
      Font.Charset = DEFAULT_CHARSET
................................................................................
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      Spacing = 0
    end
    object acttbWatchers: TActionToolBar
      Left = 633
      Top = 1
      Width = 43
      Height = 23
      ActionManager = modActions.actmgrMain
      Caption = 'Watchers'
      Color = clMenuBar
      ColorMap.DisabledFontColor = 7171437
      ColorMap.HighlightColor = clWhite
      ColorMap.BtnSelectedFont = clBlack
      ColorMap.UnusedColor = clWhite
      Font.Charset = DEFAULT_CHARSET
................................................................................
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      Spacing = 0
    end
  end
  object lvwLog: TListView
    Left = 0
    Top = 302
    Width = 676
    Height = 150
    Align = alBottom
    Columns = <
      item
        Caption = 'Timestamp'
        Width = 100
      end
      item



        Caption = 'Operation'
        Width = 100
      end

      item


        Caption = 'Name 1'

        Width = 200
      end
      item

        Caption = 'Name 2'

        Width = 200

      end
      item

        Caption = 'Folder'
      end>
    ColumnClick = False
    DoubleBuffered = True
    ReadOnly = True
    RowSelect = True
    ParentDoubleBuffered = False
    SmallImages = imlIcons
    TabOrder = 3




    ViewStyle = vsReport





  end








  object imlIcons: TImageList
    ColorDepth = cd32Bit














































































































































    Left = 152
    Top = 136
  end
end

Changes to src/FMain.pas.

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
unit FMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.WinXCtrls, Vcl.ToolWin, Vcl.ActnMan,
  Vcl.ActnCtrls, System.Actions, Vcl.ActnList, System.ImageList, Vcl.ImgList,



  Vcl.PlatformDefaultStyleActnCtrls, Vcl.ComCtrls, Vcl.StdActns;




type
  TfrmFolderWatcher = class(TForm)
    lvwFolders: TListView;
    splFoldersDetails: TSplitter;
    pnlDetails: TPanel;
    actmgrMain: TActionManager;
    imlMain: TImageList;
    actFolderRemove: TAction;
    clbrMain: TCoolBar;
    acttbFolders: TActionToolBar;
    imlIcons: TImageList;
    actFolderAdd: TBrowseForFolder;
    acttbWatchers: TActionToolBar;

    procedure actFolderRemoveExecute(Sender: TObject);
    procedure lvwFoldersSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure actFolderAddAccept(Sender: TObject);
    procedure lvwFoldersItemChecked(Sender: TObject; Item: TListItem);



  private
    { Private declarations }



  public
    { Public declarations }
  end;

var
  frmFolderWatcher: TfrmFolderWatcher;

implementation





{$R *.dfm}



























function GetFolderIconIndex(const Folder: string): Integer;


begin
  Result := -1;
  // TODO: keep track of icons for all folders, and return it if we already have it.
  // TODO: otherwise, retrieve it






end;

procedure TfrmFolderWatcher.actFolderAddAccept(Sender: TObject);
var
  Item: TListItem;
  FolderWatcher: TObject; // TODO: create class
begin
  FolderWatcher := nil; // TODO: create object

  Item := lvwFolders.Items.Add;
  Item.Caption := actFolderAdd.Folder;
  Item.ImageIndex := GetFolderIconIndex(actFolderAdd.Folder);
  Item.Data := FolderWatcher;
  Item.Checked := True; // TODO: if enabled
  Item.Selected := True;
end;

procedure TfrmFolderWatcher.actFolderRemoveExecute(Sender: TObject);




var
  i: Integer;


begin






  for i := lvwFolders.Items.Count - 1 downto 0 do begin
    if lvwFolders.Items[i].Selected then begin













      lvwFolders.Items[i].Delete;

    end;
  end;
end;

procedure TfrmFolderWatcher.lvwFoldersItemChecked(Sender: TObject; Item: TListItem);


begin





  Item.Cut := not Item.Checked;

end;

procedure TfrmFolderWatcher.lvwFoldersSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  actFolderRemove.Enabled := lvwFolders.SelCount > 0;
  Item := lvwFolders.ItemFocused;
  if Item <> nil then begin
    // TODO: display details of focused item
    pnlDetails.Visible := True;

  end else begin
    // hide details of focused item
    pnlDetails.Visible := False;

  end;
end;








































end.


<



|
|
|
>
>
>
|
>
>
>






<
<
<



<

>


<

>
>
>


>
>
>








>
>
>
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>




>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<



>
>
>
>


>
>

>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>





>
>

>
>
>
>
>
|
>





|




>



>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
unit FMain;

interface

uses
  // System
  SysUtils, Variants, Classes, IniFiles, Actions, ImageList, Generics.Collections,
  // Windows
  Windows, Messages,
  // VCL
  Graphics, Controls, Forms, Dialogs, ExtCtrls, WinXCtrls, ToolWin, ActnMan, ActnCtrls,
  ActnList, ImgList, PlatformDefaultStyleActnCtrls, ComCtrls, StdActns, Vcl.BandActn,
  Vcl.CustomizeDlg,
  // Own
  FileSystemWatcher;

type
  TfrmFolderWatcher = class(TForm)
    lvwFolders: TListView;
    splFoldersDetails: TSplitter;
    pnlDetails: TPanel;



    clbrMain: TCoolBar;
    acttbFolders: TActionToolBar;
    imlIcons: TImageList;

    acttbWatchers: TActionToolBar;
    lvwLog: TListView;
    procedure actFolderRemoveExecute(Sender: TObject);
    procedure lvwFoldersSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);

    procedure lvwFoldersItemChecked(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WatchersNotify(Sender: TObject; const Watcher: TFileSystemWatcher; Action: TCollectionNotification);
  private
    { Private declarations }
    FSettings: TIniFile;

    function GetFolderIconIndex(const Folder: string): Integer;
  public
    { Public declarations }
  end;

var
  frmFolderWatcher: TfrmFolderWatcher;

implementation
uses
  UITypes, IOUtils, ZLib,
  ShellUtils, L_SpecialFolders,
  M_Actions;

{$R *.dfm}

procedure TfrmFolderWatcher.FormCreate(Sender: TObject);
var
  tmpIcon: TIcon;
begin
  FSettings := TIniFile.Create(TPath.Combine(TSpecialFolders.Settings, Application.Name + '.ini'));

  tmpIcon := TIcon.Create;
  try
    tmpIcon.Handle := LoadIcon(0, IDI_ERROR);
    imlIcons.InsertIcon(0, tmpIcon);
    tmpIcon.Handle := LoadIcon(0, IDI_WARNING);
    imlIcons.InsertIcon(0, tmpIcon);
    tmpIcon.Handle := LoadIcon(0, IDI_INFORMATION);
    imlIcons.InsertIcon(0, tmpIcon);
  finally
    tmpIcon.Free;
  end;

//  ActiveFolder := FSettings.ReadString('Settings', 'ActiveFolder', '');
end {TfrmFolderWatcher.FormCreate};

procedure TfrmFolderWatcher.FormDestroy(Sender: TObject);
begin
  FSettings.Free;
end;

function TfrmFolderWatcher.GetFolderIconIndex(const Folder: string): Integer;
var
  Icon: TIcon;
begin
  Result := -1;
  // TODO: keep track of icons for all folders, and return it if we already have it.
  // TODO: otherwise, retrieve it
  Icon := ShellUtils.GetShellFolderIcon(Folder, False, False);
  try
    if not Icon.Empty then
      Result := imlIcons.AddIcon(Icon);
  finally
    Icon.Free;
  end;














end;

procedure TfrmFolderWatcher.actFolderRemoveExecute(Sender: TObject);
resourcestring
  rsExplanation = 'Removing a folder from the list means all the relevant settings will be lost.'
                + ' If you merely want to (temporarily) disable the watch on that folder, just remove'
                + ' its check mark.';
var
  i: Integer;
  Folders: string;
  Answer: Integer;
begin
  case lvwFolders.SelCount of
    Low(Integer)..0:  Exit;
    1:  Answer := TaskMessageDlg(Format('Remove folder "%s"?', [ExtractFileName(lvwFolders.Selected.Caption)]),
                                lvwFolders.Selected.Caption + sLineBreak + sLineBreak + rsExplanation,
                                mtConfirmation, mbYesNo, HelpContext, mbNo);
    else begin
      for i := lvwFolders.Items.Count - 1 downto 0 do begin
        if lvwFolders.Items[i].Selected then begin
          Folders := Folders + lvwFolders.Items[i].Caption + sLineBreak;
        end;
      end {for};
      Answer := TaskMessageDlg(Format('Remove %d folders?', [lvwFolders.SelCount]),
                                Folders + sLineBreak + rsExplanation,
                                mtConfirmation, mbYesNo, HelpContext, mbNo);
    end;
  end;
  if Answer = mrYes then begin
    for i := lvwFolders.Items.Count - 1 downto 0 do begin
      if lvwFolders.Items[i].Selected then begin
        modActions.Watchers.Remove(TFileSystemWatcher(lvwFolders.Items[i].Data));
//        FSettings.DeleteKey('Folders', lvwFolders.Items[i].Caption);
//        lvwFolders.Items[i].Delete;
      end;
    end;
  end;
end;

procedure TfrmFolderWatcher.lvwFoldersItemChecked(Sender: TObject; Item: TListItem);
var
  Watcher: TFileSystemWatcher;
begin
  if not (TObject(Item.Data) is TFileSystemWatcher) then Exit;
  if Item.Caption = '' then Exit;

  Watcher := TFileSystemWatcher(Item.Data);
  Watcher.Enabled := Item.Checked;
  Item.Cut := not Watcher.Enabled;
  FSettings.WriteBool('Folders', Item.Caption, Watcher.Enabled);
end;

procedure TfrmFolderWatcher.lvwFoldersSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  modActions.actFolderRemove.Enabled := lvwFolders.SelCount > 0;
  Item := lvwFolders.ItemFocused;
  if Item <> nil then begin
    // TODO: display details of focused item
    pnlDetails.Visible := True;
    FSettings.WriteString('Settings', 'ActiveFolder', Item.Caption);
  end else begin
    // hide details of focused item
    pnlDetails.Visible := False;
    FSettings.DeleteKey('Settings', 'ActiveFolder');
  end;
end;

procedure TfrmFolderWatcher.WatchersNotify(Sender: TObject; const Watcher: TFileSystemWatcher; Action: TCollectionNotification);
var
  i: Integer;
  Item: TListItem;
begin
  case Action of
    cnAdded: begin
      Item := lvwFolders.Items.Add;
      Item.Data := Watcher;
      Item.Caption := Watcher.WatchedDir;
      Item.ImageIndex := GetFolderIconIndex(Watcher.WatchedDir);
      Item.Checked := Watcher.Enabled;

      if SameFileName(Watcher.WatchedDir, FSettings.ReadString('Settings', 'ActiveFolder', '')) then
        Item.Focused := True;

//      FSettings.WriteBool('Folders', Watcher.WatchedDir, Watcher.Enabled);

      lvwFolders.Columns[0].Width := -2;
    end;

    cnRemoved: begin
      for i := lvwFolders.Items.Count - 1 downto 0 do begin
        if lvwFolders.Items[i].Data = Watcher then begin
          if lvwFolders.Items[i].Selected then
            lvwFolders.Items[i].Selected := False;
          lvwFolders.Items[i].Delete;
          Break;
        end;
      end {for};
      FSettings.DeleteKey('Folders', Watcher.WatchedDir);
    end;

    cnExtracted: begin
      Assert(False, 'Watchers should not get extracted!');
    end;
  end;
end {TfrmFolderWatcher.WatchersNotify};

end.

Added src/FileSystemWatcher.pas.





























































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
unit FileSystemWatcher;

interface
uses
  Windows, Classes, SysUtils;

type
  TFileSystemWatcher = class;

  TFileOperation = (foAdded, foRemoved, foModified, foRenamed);
  TFileDealMethod = procedure(Sender: TFileSystemWatcher; FileOperation: TFileOperation; const FileName1,FileName2: string) of object;

  TNotifyFilter = (nfFileNameChange, nfDirNameChange, nfAttributeChange,
    nfSizeChange, nfWriteChange, nfAccessChange, nfCreationDateChange, nfSecurityChange);
  TNotifyFilters = set of TNotifyFilter;

  TNotificationBuffer =  array[0..4095] of Byte;

  PFileNotifyInformation = ^TFileNotifyInformation;
  TFileNotifyInformation = record
    NextEntryOffset: DWORD;
    Action: DWORD;
    FileNameLength: DWORD;
    FileName: array[0..0] of WideChar;
  end;

  TShellChangeThread = class(TThread)
  private
    FEnabled: Boolean;
    FDirectoryHandle: THandle;
    FCS: TRTLCriticalSection;
    FChangeEvent: TFileDealMethod;
    FSender: TFileSystemWatcher;
    FDirectory: string;
    FWatchSubTree: Boolean;
    FCompletionPort: THandle;
    FOverlapped: TOverlapped;
    FNotifyOptionFlags: DWORD;
    FBytesWritten: DWORD;
    FNotificationBuffer: TNotificationBuffer;
  protected
    procedure Execute; override;
    procedure DoIOCompletionEvent;
    function ResetReadDirectory: Boolean;
    procedure Lock;
    procedure Unlock;
  public
    constructor Create(ChangeEvent: TFileDealMethod; Sender: TFileSystemWatcher); virtual;
    destructor Destroy; override;
    procedure SetDirectoryOptions(Directory : String; Enabled: Boolean; WatchSubTree : Boolean;
      NotifyOptionFlags : DWORD);
    property ChangeEvent : TFileDealMethod read FChangeEvent write FChangeEvent;
  end;


  TFileSystemWatcher = class(TComponent)
  private
    FEnabled: Boolean;
    FWatchedDir: string;
    FThread: TShellChangeThread;
    FOnChange: TFileDealMethod;
    FWatchSubTree: Boolean;
    FFilters: TNotifyFilters;
    procedure SetWatchedDir(const Value: string);
    procedure SetWatchSubTree(const Value: Boolean);
    procedure SetOnChange(const Value: TFileDealMethod);
    procedure SetFilters(const Value: TNotifyFilters);
    function  NotifyOptionFlags: DWORD;
    procedure SetEnabled(const Value: Boolean);
  protected
    procedure Change;
    procedure Start;
    procedure Stop;
  public
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy; override;
  published
    property  Enabled: Boolean              read FEnabled       write SetEnabled;
    property  WatchedDir: string            read FWatchedDir    write SetWatchedDir;
    property  WatchSubTree: Boolean         read FWatchSubTree  write SetWatchSubTree;
    property  NotifyFilters: TNotifyFilters read FFilters       write SetFilters;
    property  OnChange: TFileDealMethod     read FOnChange      write SetOnChange;
  end;

procedure  Register;

implementation

procedure  Register;
begin
  RegisterComponents('Samples', [TFileSystemWatcher]);
end;

{ TShellChangeThread }

constructor TShellChangeThread.Create(ChangeEvent: TFileDealMethod; Sender: TFileSystemWatcher);
begin
  FreeOnTerminate := True;
  FChangeEvent := ChangeEvent;
  FSender := Sender;
  InitializeCriticalSection(FCS);
  FDirectoryHandle := 0;
  FCompletionPort := 0;
  inherited Create(True);
end;

destructor TShellChangeThread.Destroy;
begin
  CloseHandle(FDirectoryHandle);
  CloseHandle(FCompletionPort);
  DeleteCriticalSection(FCS);
  inherited Destroy;
end;

procedure TShellChangeThread.DoIOCompletionEvent;
var
  TempBuffer: TNotificationBuffer;
  FileOpNotification: PFileNotifyInformation;
  Offset: DWORD;
  FileName1, FileName2: string;
  FileOperation: TFileOperation;
  procedure DoDirChangeEvent;
  begin
    if Assigned(ChangeEvent) and FEnabled then
      ChangeEvent(FSender, FileOperation, FileName1, FileName2);
  end;
  function  CompleteFileName(const FileName:string):string;
  begin
    Result := '';
    if Trim(FileName) <> '' then
      Result := FDirectory + Trim(FileName);
  end;
begin
  Lock;
  TempBuffer := FNotificationBuffer;
  FillChar(FNotificationBuffer, SizeOf(FNotificationBuffer), 0);
  Unlock;

//  with TFileStream.Create('C:\MC\Temp\NotificationBuffer', fmCreate or fmShareDenyWrite) do
//  try
//    Write(TempBuffer, SizeOf(TempBuffer));
//  finally
//    Free;
//  end;

  Pointer(FileOpNotification) := @TempBuffer[0];
  repeat
    with FileOpNotification^ do begin
      Offset := NextEntryOffset;
      FileName2 := '';
      case Action of
        FILE_ACTION_ADDED..FILE_ACTION_MODIFIED: begin
          FileName1 := CompleteFileName(WideCharToString(FileName));
          FileOperation := TFileOperation(Action - 1);
          DoDirChangeEvent;
        end;
        FILE_ACTION_RENAMED_OLD_NAME: begin
          FileName1 := CompleteFileName(WideCharToString(FileName));
          FileOperation := TFileOperation(Action - 1);
        end;
        FILE_ACTION_RENAMED_NEW_NAME: begin
          if FileOperation = foRenamed then begin
          FileName2 := CompleteFileName(WideCharToString(FileName));
          DoDirChangeEvent;
          end;
        end;
      end;
    end;
    PByte(FileOpNotification) := PByte(FileOpNotification) + OffSet;
  until Offset=0;
end;

procedure TShellChangeThread.Execute;
var
  numBytes: DWORD;
  CompletionKey: ULONG_PTR;
  PFOverlapped: POverlapped;
  TempDirectoryHandle: THandle;
  TempCompletionPort: THandle;
begin
  TempCompletionPort := FCompletionPort;
  while not Terminated do begin
    Lock;
    TempDirectoryHandle := FDirectoryHandle;
    TempCompletionPort := FCompletionPort;
    Unlock;
    if TempDirectoryHandle > 0  then begin
      PFOverlapped := @FOverlapped;
      GetQueuedCompletionStatus(TempCompletionPort, numBytes, CompletionKey, PFOverlapped, INFINITE);
      if CompletionKey = Handle then begin
        Synchronize(DoIOCompletionEvent);
        FBytesWritten := 0;
        FillChar(FNotificationBuffer, SizeOf(FNotificationBuffer), 0);
        Win32Check(ReadDirectoryChanges(FDirectoryHandle,
                                        @FNotificationBuffer, SizeOf(FNotificationBuffer),
                                        FWatchSubTree, FNotifyOptionFlags,
                                        @FBytesWritten, @FOverlapped, nil));
      end;
    end;
  end;
  PostQueuedCompletionStatus(TempCompletionPort, 0, 0, nil);
end;

procedure TShellChangeThread.Lock;
begin
  EnterCriticalSection(FCS);
end;

function TShellChangeThread.ResetReadDirectory: Boolean;
var
  TempHandle: Cardinal;
  TempCompletionPort: Cardinal;
begin
  Result := False;
  CloseHandle(FDirectoryHandle);
  PostQueuedCompletionStatus(FCompletionPort, 0, 0, nil);
  CloseHandle(FCompletionPort);


  TempHandle := CreateFile(PChar(FDirectory), GENERIC_READ or GENERIC_WRITE,
          FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
          nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
  Lock;
  FDirectoryHandle := TempHandle;
  Unlock;

  if (GetLastError = ERROR_FILE_NOT_FOUND) or (GetLastError = ERROR_PATH_NOT_FOUND) then begin
    Lock;
    FDirectoryHandle := 0;
    FCompletionPort := 0;
    Unlock;
    Exit;
  end;

  TempCompletionPort := CreateIoCompletionPort(FDirectoryHandle, 0, Handle, 0);

  Lock;
  FCompletionPort := TempCompletionPort;
  Unlock;

  FBytesWritten := 0;
  FillChar(FNotificationBuffer, SizeOf(FNotificationBuffer), 0);
  Result := ReadDirectoryChanges(FDirectoryHandle,
                                 @FNotificationBuffer, SizeOf(FNotificationBuffer),
                                 FWatchSubTree, FNotifyOptionFlags,
                                 @FBytesWritten, @FOverlapped, nil);
  if not Result then
    RaiseLastOSError;
end;

procedure TShellChangeThread.SetDirectoryOptions(Directory: String; Enabled: Boolean;
  WatchSubTree: Boolean;  NotifyOptionFlags : DWORD);
begin
  FWatchSubTree := WatchSubTree;
  FNotifyOptionFlags := NotifyOptionFlags;
  FDirectory := IncludeTrailingBackslash(Directory);
  FEnabled := Enabled;
  ResetReadDirectory;
end;

procedure TShellChangeThread.Unlock;
begin
  LeaveCriticalSection(FCS);
end;

{ TFileSystemWatcher }

procedure TFileSystemWatcher.Change;
begin
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FThread) then begin
    FThread.SetDirectoryOptions(FWatchedDir, FEnabled, LongBool(FWatchSubTree), NotifyOptionFlags);
  end;
end;

constructor TFileSystemWatcher.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := False;
  FWatchedDir := 'C:\';
  FFilters := [nfFilenameChange, nfDirNameChange];
  FWatchSubTree := True;
  FOnChange := nil;
end;

destructor TFileSystemWatcher.Destroy;
begin
  if Assigned(FThread) then
    FThread.Terminate;
  inherited Destroy;
end;

function TFileSystemWatcher.NotifyOptionFlags: DWORD;
begin
  Result := 0;
  if nfFileNameChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_FILE_NAME;
  if nfDirNameChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_DIR_NAME;
  if nfSizeChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_SIZE;
  if nfAttributeChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_ATTRIBUTES;
  if nfWriteChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_LAST_WRITE;
  if nfAccessChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_LAST_ACCESS;
  if nfCreationDateChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_CREATION;
  if nfSecurityChange in FFilters then
    Result := Result or FILE_NOTIFY_CHANGE_SECURITY;
end;

procedure TFileSystemWatcher.SetEnabled(const Value: Boolean);
begin
  if FEnabled <> Value then begin
    FEnabled := Value;
    Change;
    if FEnabled then
      Start
    else
      Stop;
  end;
end;

procedure TFileSystemWatcher.SetFilters(const Value: TNotifyFilters);
begin
  if FFilters <> Value then begin
    FFilters := Value;
    Change;
  end;
end;

procedure TFileSystemWatcher.SetOnChange(const Value: TFileDealMethod);
begin
  FOnChange := Value;
  if Assigned(FOnChange) and FEnabled then
    Start
  else
    Stop;
  Change;
end;

procedure TFileSystemWatcher.SetWatchedDir(const Value: string);
begin
  if not SameText(FWatchedDir, Value) then begin
    FWatchedDir := Value;
    Change;
  end;
end;

procedure TFileSystemWatcher.SetWatchSubTree(const Value: Boolean);
begin
  if FWatchSubTree <> Value then begin
    FWatchSubTree := Value;
    Change;
  end;
end;

procedure TFileSystemWatcher.Start;
begin
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FOnChange) then begin
    FThread := TShellChangeThread.Create(FOnChange, Self);
    FThread.SetDirectoryOptions(FWatchedDir, FEnabled, LongBool(FWatchSubTree), NotifyOptionFlags);
    FThread.Start;
  end;
end;

procedure TFileSystemWatcher.Stop;
begin
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FThread) then begin
    FThread.Terminate;
    FThread := nil;
  end;
end;

end.

Added src/L_SpecialFolders.pas.

























































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
unit L_SpecialFolders;

(*Description: TSpecialFolders is een class waar het pad van alle 'speciale' mappen
 *               mee opgevraagd kan worden.  Het zijn allemaal class properties, dus er
 *               hoeft niet eerst een instantie aangemaakt te worden.
 *              Deze class is betrouwbaarder dan EnvironmentVariables, Application.ExeName
 *               of ParamStr(0), want EnvironmentVariables zijn niet altijd allemaal gedefinieerd,
 *               en ParamStr(0) is niet beschikbaar vanuit een Dll.
 *              Wanneer de Dll-properties vanuit een EXE worden aangeroepen, wordt het pad van
 *               de EXE gebruikt.
 *              Als met de functies TempExe, TempDll, en TempExeDll een nieuwe directory wordt
 *               gemaakt, dan wordt deze geleegd bij het afsluiten van het programma.
 *              Met de functie Settings kan het pad opgevraagd worden waar instellingen opgeslagen
 *               zouden moeten worden, rekening houdend met de volgende factoren:
 *               - sfUserSpecific: of het pad gebruikersgebonden moet zijn, of voor alle gebruikers moet gelden;
 *               - sfMachineSpecific: of het pad alleen op de huidige machine moet gelden (local),
 *                  of ook met het gebruikersprofiel op het netwerk gekopieerd mag worden (roaming)
 *               - sfExeSpecific: of de naam van de Exe aan het pad toegevoegd moet worden;
 *               - sfDllSpecific: of de naam van de Dll (of van de Exe als we niet in een Dll zitten)
 *                  aan het pad toegevoegd moet worden.
 *               De functie Settings zonder parameters haalt [sfUserSpecific, sfDllSpecific] op.
 * Examples:
 *    TSpecialFolders.Settings;                 // C:\Users\Martijn\AppData\Roaming\notepad++\
 *    TSpecialFolders.Settings([sfMachineSpecific, sfDllSpecific]); // C:\ProgramData\PreviewHTML\
 *    TSpecialFolders.Settings([sfUserSpecific, sfMachineSpecific, sfExeSpecific, sfDllSpecific]); // C:\Users\Martijn\AppData\Local\notepad++\PreviewHTML\
 *    TSpecialFolders.Exe;                      // C:\MC\Run\Office\Notepad++\
 *    TSpecialFolders.ExeFullName;              // C:\MC\Run\Office\Notepad++\notepad++.exe
 *    TSpecialFolders.DLL;                      // C:\MC\Run\Office\Notepad++\
 *    TSpecialFolders.DLLFullName;              // C:\MC\Run\Office\Notepad++\Plugins\PreviewHTML.dll
 *    TSpecialFolders.Temp;                     // C:\Users\Martijn\AppData\Local\Temp\
 *    TSpecialFolders.TempExe;                  // C:\Users\Martijn\AppData\Local\Temp\notepad++\
 *    TSpecialFolders.TempDll;                  // C:\Users\Martijn\AppData\Local\Temp\PreviewHTML\
 *    TSpecialFolders.TempExeDll;               // C:\Users\Martijn\AppData\Local\Temp\notepad++\PreviewHTML\
 *    TSpecialFolders.Windows;                  // C:\Windows\
 *    TSpecialFolders.System;                   // C:\Windows\system32\
 *    TSpecialFolders.AppData;                  // C:\Users\Martijn\AppData\Roaming\
 *    TSpecialFolders.CommonAppData;            // C:\ProgramData\
 *                                              // C:\Documents and Settings\All Users\Application Data\
 *    TSpecialFolders.AppDataLocal;             // C:\Users\Martijn\AppData\Local\
 *                                              // C:\Documents and Settings\Martijn\Local Settings\Application Data\
 *    TSpecialFolders.ProgramFiles;             // C:\Program Files\          <= 64-bits EXE on 64-bits OS or 32-bits EXE on 32-bits OS
 *                                              // C:\Program Files (x86)\    <= 32-bits EXE on 64-bits OS
 *    TSpecialFolders.CommonProgramFiles;       // C:\Program Files (x86)\Common Files\
 *    TSpecialFolders.ProgramFilesX86;          // C:\Program Files (x86)\
 *    TSpecialFolders.CommonProgramFilesX86;    // C:\Program Files (x86)\Common Files\
 *    TSpecialFolders.Desktop;                  // C:\Users\Martijn\Desktop\
 *    TSpecialFolders.CommonDesktop;            // C:\Users\Public\Desktop\
 *    TSpecialFolders.Documents;                // C:\Users\Martijn\Documents\
 *    TSpecialFolders.CommonDocuments;          // C:\Users\Public\Documents\
 *    TSpecialFolders.Pictures;                 // C:\Users\Martijn\Pictures\
 *    TSpecialFolders.CommonPictures;           // C:\Users\Public\Pictures\
 *    TSpecialFolders.Music;                    // C:\Users\Martijn\Music\
 *    TSpecialFolders.CommonMusic;              // C:\Users\Public\Music\
 *    TSpecialFolders.Video;                    // C:\Users\Martijn\Videos\
 *    TSpecialFolders.CommonVideo;              // C:\Users\Public\Videos\
 *    TSpecialFolders.AdminTools;               // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Administrative Tools\
 *    TSpecialFolders.CommonAdminTools;         // C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Administrative Tools\
 *    TSpecialFolders.Favorites;                // C:\Users\Martijn\Favorites\
 *    TSpecialFolders.CommonFavorites;          // C:\Users\Martijn\Favorites\
 *    TSpecialFolders.StartMenu;                // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Start Menu\
 *    TSpecialFolders.CommonStartMenu;          // C:\ProgramData\Microsoft\Windows\Start Menu\
 *    TSpecialFolders.StartMenuPrograms;        // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\
 *    TSpecialFolders.CommonStartMenuPrograms;  // C:\ProgramData\Microsoft\Windows\Start Menu\Programs\
 *    TSpecialFolders.StartUp;                  // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\
 *    TSpecialFolders.CommonStartUp;            // C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\
 *    TSpecialFolders.Templates;                // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Templates\
 *    TSpecialFolders.CommonTemplates;          // C:\ProgramData\Microsoft\Windows\Templates\
 *    TSpecialFolders.Cookies;                  // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Cookies\
 *    TSpecialFolders.DiscBurnArea;             // C:\Users\Martijn\AppData\Local\Microsoft\Windows\Burn\Burn\
 *    TSpecialFolders.History;                  // C:\Users\Martijn\AppData\Local\Microsoft\Windows\History\
 *    TSpecialFolders.NetHood;                  // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Network Shortcuts\
 *    TSpecialFolders.PrintHood;                // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Printer Shortcuts\
 *    TSpecialFolders.Recent;                   // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\Recent\
 *    TSpecialFolders.SendTo;                   // C:\Users\Martijn\AppData\Roaming\Microsoft\Windows\SendTo\
 *
 *)

interface

uses
  ShlObj, SHFolder;

type
  TSettingsFlag = (sfUserSpecific, sfMachineSpecific, sfExeSpecific, sfDllSpecific);
  TSettingsFlags = set of TSettingsFlag;

  TSpecialFolders = class
  private
    class procedure AddTempFolder(const TempDir: string);
    class procedure DeleteTempFolders;
    class function GetModulePathName(const hInst: Cardinal): string;

    class function GetExe: string; static; inline;
    class function GetExeDir: string; static; inline;
    class function GetExeBaseName: string; static; inline;
    class function GetDll: string; static; inline;
    class function GetDllDir: string; static; inline;
    class function GetDllBaseName: string; static; inline;
    class function GetWindowsDir: string; static;
    class function GetWindowsSysDir: string; static;
    class function GetTempDir(const Index: Integer): string; static;
    class function GetCSIDLDir(const CSIDL: Integer): string; static; // Constant Special Item ID List
  protected
    class function GetHToken: Cardinal; virtual;
  public
    class function Settings(Flags: TSettingsFlags = [sfUserSpecific, sfDllSpecific]): string;

    class property Exe: string                    read GetExeDir;
    class property ExeFullName: string            read GetExe;
    class property DLL: string                    read GetDllDir;
    class property DLLFullName: string            read GetDll;
    class property Temp: string           index 0 read GetTempDir;
    class property TempExe: string        index 1 read GetTempDir;
    class property TempDll: string        index 2 read GetTempDir;
    class property TempExeDll: string     index 3 read GetTempDir;

    class property Windows: string                read GetWindowsDir;
    class property System: string                 read GetWindowsSysDir;

    class property AppData: string                  index CSIDL_APPDATA                 read GetCSIDLDir;
    class property CommonAppData: string            index CSIDL_COMMON_APPDATA          read GetCSIDLDir;
    class property AppDataLocal: string             index CSIDL_LOCAL_APPDATA           read GetCSIDLDir;
    class property ProgramFiles: string             index CSIDL_PROGRAM_FILES           read GetCSIDLDir;
    class property ProgramFilesCommon: string       index CSIDL_PROGRAM_FILES_COMMON    read GetCSIDLDir;
    class property ProgramFilesX86: string          index CSIDL_PROGRAM_FILESX86        read GetCSIDLDir;
    class property ProgramFilesX86Common: string    index CSIDL_PROGRAM_FILES_COMMONX86 read GetCSIDLDir;

    class property Desktop: string                  index CSIDL_DESKTOPDIRECTORY        read GetCSIDLDir;
    class property CommonDesktop: string            index CSIDL_COMMON_DESKTOPDIRECTORY read GetCSIDLDir;
    class property Documents: string                index CSIDL_PERSONAL                read GetCSIDLDir;
    class property CommonDocuments: string          index CSIDL_COMMON_DOCUMENTS        read GetCSIDLDir;
    class property Pictures: string                 index CSIDL_MYPICTURES              read GetCSIDLDir;
    class property CommonPictures: string           index CSIDL_COMMON_PICTURES         read GetCSIDLDir;
    class property Music: string                    index CSIDL_MYMUSIC                 read GetCSIDLDir;
    class property CommonMusic: string              index CSIDL_COMMON_MUSIC            read GetCSIDLDir;
    class property Video: string                    index CSIDL_MYVIDEO                 read GetCSIDLDir;
    class property CommonVideo: string              index CSIDL_COMMON_VIDEO            read GetCSIDLDir;

    class property AdminTools: string               index CSIDL_ADMINTOOLS              read GetCSIDLDir;
    class property CommonAdminTools: string         index CSIDL_COMMON_ADMINTOOLS       read GetCSIDLDir;
    class property Favorites: string                index CSIDL_FAVORITES               read GetCSIDLDir;
    class property CommonFavorites: string          index CSIDL_COMMON_FAVORITES        read GetCSIDLDir;
    class property StartMenu: string                index CSIDL_STARTMENU               read GetCSIDLDir;
    class property CommonStartMenu: string          index CSIDL_COMMON_STARTMENU        read GetCSIDLDir;
    class property StartMenuPrograms: string        index CSIDL_PROGRAMS                read GetCSIDLDir;
    class property CommonStartMenuPrograms: string  index CSIDL_COMMON_PROGRAMS         read GetCSIDLDir;
    class property StartUp: string                  index CSIDL_STARTUP                 read GetCSIDLDir;
    class property CommonStartUp: string            index CSIDL_COMMON_STARTUP          read GetCSIDLDir;
    class property Templates: string                index CSIDL_TEMPLATES               read GetCSIDLDir;
    class property CommonTemplates: string          index CSIDL_COMMON_TEMPLATES        read GetCSIDLDir;

    class property Cookies: string                  index CSIDL_COOKIES                 read GetCSIDLDir;
    class property DiscBurnArea: string             index CSIDL_CDBURN_AREA             read GetCSIDLDir;
    class property History: string                  index CSIDL_HISTORY                 read GetCSIDLDir;
    class property NetHood: string                  index CSIDL_NETHOOD                 read GetCSIDLDir;
    class property PrintHood: string                index CSIDL_PRINTHOOD               read GetCSIDLDir;
    class property Recent: string                   index CSIDL_RECENT                  read GetCSIDLDir;
    class property SendTo: string                   index CSIDL_SENDTO                  read GetCSIDLDir;

    class property ByCSIDL[const CSIDL: Integer]: string                                read GetCSIDLDir;
  end;

implementation

uses
  Windows, SysUtils, ComObj, Classes, IOUtils;

var
  TempFolders: TStringList;

type
  TStringAPICallback = reference to function(lpBuffer: PChar; nSize: Cardinal): Cardinal;

{ ------------------------------------------------------------------------------------------------ }
function CallAPIStringFunction(const Callback: TStringAPICallback;
                               const InitialSize: integer = MAX_PATH): string;
var
  iSize, iResult, iError: integer;
begin
  iSize := InitialSize;
  repeat
    SetLength(Result, iSize);
    iResult := Callback(PChar(Result), iSize);
    iError := GetLastError;
    if iResult = 0 then begin
      if iError = ERROR_SUCCESS then begin
        Result := '';
        Exit;
      end else begin
        RaiseLastOSError;
      end;
    end else if iResult >= iSize then begin
      iSize := iResult + 1;
    end else begin
      SetLength(Result, iResult);
      Break;
    end;
  until iResult < iSize;
end {GetStringFromAPI};


{ ================================================================================================ }
{ TSpecialFolders }

{ ------------------------------------------------------------------------------------------------ }
class procedure TSpecialFolders.AddTempFolder(const TempDir: string);
begin
  if not DirectoryExists(TempDir) then begin
    if not Assigned(TempFolders) then
      TempFolders := TStringList.Create;
    TempFolders.Add(TempDir);
  end;
end {TSpecialFolders.AddTempFolder};

{ ------------------------------------------------------------------------------------------------ }
class procedure TSpecialFolders.DeleteTempFolders;
var
  i: Integer;
begin
  if Assigned(TempFolders) then begin
    for i := TempFolders.Count - 1 downto 0 do begin
      // remove all files first
      TDirectory.Delete(TempFolders[i], True);
      RemoveDir(TempFolders[i]);
    end;
    FreeAndNil(TempFolders);
  end;
end {TSpecialFolders.DeleteTempFolders};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetCSIDLDir(const CSIDL: Integer): string;
var
  Buffer: array[0..MAX_PATH] of Char;
  PBuffer: PChar;
begin
  PBuffer := PChar(@Buffer[0]);
  OleCheck(SHGetFolderPath(0, CSIDL or CSIDL_FLAG_CREATE, GetHToken, SHGFP_TYPE_CURRENT, PBuffer));
  Result := IncludeTrailingPathDelimiter(string(PBuffer));
end {TSpecialFolders.GetCSIDLDir};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetDll: string;
begin
  Result := GetModulePathName(HInstance);
end {TSpecialFolders.GetDll};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetDllDir: string;
begin
  Result := ExtractFilePath(GetDll);
end {TSpecialFolders.GetDllDir};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetDllBaseName: string;
begin
  Result := ChangeFileExt(ExtractFileName(GetDll), '');
end {TSpecialFolders.GetDllName};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetExe: string;
begin
  Result := GetModulePathName(0);
end {TSpecialFolders.GetExe};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetExeDir: string;
begin
  Result := ExtractFilePath(GetExe);
end {TSpecialFolders.GetExeDir};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetHToken: Cardinal;
begin
  Result := 0; // use `High(Cardinal)` instead of `0` for default user's paths
end {TSpecialFolders.GetHToken};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetExeBaseName: string;
begin
  Result := ChangeFileExt(ExtractFileName(GetExe), '');
end {TSpecialFolders.GetExeName};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetModulePathName(const hInst: Cardinal): string;
begin
  Result := CallAPIStringFunction(
              function(lpBuffer: PChar; nSize: Cardinal): Cardinal
              begin
                Result := GetModuleFileName(hInst, lpBuffer, nSize);
              end);
  if SameStr(Copy(Result, 1, 4), '\\?\') then
    Result := Copy(Result, 5);
end {TSpecialFolders.GetModulePathName};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetTempDir(const Index: Integer): string;
begin
  Result := CallAPIStringFunction(
              function(lpBuffer: PChar; nSize: Cardinal): Cardinal
              begin
                Result := GetTempPath(nSize, lpBuffer);
              end);
  if Index in [1, 3] then begin
    Result := Result + IncludeTrailingPathDelimiter(GetExeBaseName);
    AddTempFolder(Result);
  end;
  if (Index = 2) or ((Index = 3) and not SameFileName(GetExe, GetDll)) then begin
    Result := Result + IncludeTrailingPathDelimiter(GetDllBaseName);
    AddTempFolder(Result);
  end;
  ForceDirectories(Result);
end {TSpecialFolders.GetTempDir};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetWindowsDir: string;
begin
  Result := CallAPIStringFunction(
              function(lpBuffer: PChar; nSize: Cardinal): Cardinal
              begin
                Result := GetWindowsDirectory(lpBuffer, nSize);
              end);
  Result := IncludeTrailingPathDelimiter(Result);
end {TSpecialFolders.GetWindowsDir};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.GetWindowsSysDir: string;
begin
  Result := CallAPIStringFunction(
              function(lpBuffer: PChar; nSize: Cardinal): Cardinal
              begin
                Result := GetSystemDirectory(lpBuffer, nSize);
              end);
  Result := IncludeTrailingPathDelimiter(Result);
end {TSpecialFolders.GetWindowSysDir};

{ ------------------------------------------------------------------------------------------------ }
class function TSpecialFolders.Settings(Flags: TSettingsFlags): string;
var
  CSIDL: Integer;
begin
  if not (sfUserSpecific in Flags) then
    CSIDL := CSIDL_COMMON_APPDATA
  else if sfMachineSpecific in Flags then
    CSIDL := CSIDL_LOCAL_APPDATA
  else
    CSIDL := CSIDL_APPDATA
  ;
  Result := GetCSIDLDir(CSIDL);

  if (sfExeSpecific in Flags) then begin
    Result := Result + IncludeTrailingPathDelimiter(GetExeBaseName);
  end;
  if (sfDllSpecific in Flags) and not ((sfExeSpecific in Flags) and SameFilename(GetExe, GetDll)) then begin
    Result := Result + IncludeTrailingPathDelimiter(GetDllBaseName);
  end;
  ForceDirectories(Result);
end {TSpecialFolders.SettingsDir};

initialization

finalization
  TSpecialFolders.DeleteTempFolders;

end.

Added src/L_SysParamInfo.pas.





































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
unit L_SysParamInfo;

////////////////////////////////////////////////////////////////////////////////////////////////////
interface
uses
  Windows, Graphics;

{ ------------------------------------------------------------------------------------------------ }
const
  // omitted from the Windows unit
  {$EXTERNALSYM SPI_GETDESKWALLPAPER}
  SPI_GETDESKWALLPAPER = 115;
  {$EXTERNALSYM SPI_GETBLOCKSENDINPUTRESETS}
  SPI_GETBLOCKSENDINPUTRESETS = $1026;
  {$EXTERNALSYM SPI_SETBLOCKSENDINPUTRESETS}
  SPI_SETBLOCKSENDINPUTRESETS = $1027;
  {$EXTERNALSYM SPI_SETSCREENSAVERRUNNING}
  SPI_SETSCREENSAVERRUNNING = 97;

{ ------------------------------------------------------------------------------------------------ }
type
  TSystemParameter = (spAccessTimeout, spFilterKeys, spHighContrast, spSoundSentry,
                      spMouseKeys, spSerialKeys, spStickyKeys, spToggleKeys,
                      spFocusBorderWidth, spFocusBorderHeight, spMouseClickLock, spMouseClickLockTime,
                      spMouseSonar, spMouseVanish, spScreenReader, spShowSounds,
                      spDeskWallpaper, spDropShadow, spFlatMenu, spFontSmoothing,
                      spFontSmoothingContrast, spFontSmoothingType, spWorkArea,
                      spResetCursors, spResetDeskPattern,
                      spIconMetrics, spIconTitleFont, spIconTitleWrap,
                      spIconHorizontalSpacing, spIconVerticalSpacing, spResetIcons,
                      spBeep, spBlockSendInputResets, spDefaultInputLang,
                      spKeyboardCues, spKeyboardDelay, spKeyboardPreferred, spKeyboardSpeed,
                      spMouse, spMouseHoverHeight, spMouseHoverTime, spMouseHoverWidth,
                      spMouseSpeed, spMouseTrails, spSnapToDefButton, spWheelScrollLines,
                      spRefreshLangToggle, spMouseButtonSwap,
                      spMenuDropAlignment, spMenuFade, spMenuShowDelay,
                      spLowPowerActive, spLowPowerTimeout, spPowerOffActive, spPowerOffTimeout,
                      spScreenSaveSet, spScreenSaverRunning, spScreenSaveTimeout,
                      spComboBoxAnimation, spCursorShadow, spGradientCaptions, spHottracking,
                      spListboxSmoothScrolling, spMenuAnimation, spSelectionFade, spTooltipAnimation,
                      spTooltipFade, spAllUIEffects,
                      spActiveWindowTracking, spActiveWndTrkZOrder, spActiveWndTrkTimeout,
                      spAnimation, spBorder, spCaretWidth, spDragFullWindows,
                      spForegroundFlashCount, spForegroundLockTimeout,
                      spMinimizedMetrics, spNonClientMetrics, spShowIMEUI,
                      spDragHeight, spDragWidth);
const
  cSystemGetIndex: array[TSystemParameter] of integer =
                     (SPI_GETACCESSTIMEOUT, SPI_GETFILTERKEYS, SPI_SETHIGHCONTRAST, SPI_GETSOUNDSENTRY,
                      SPI_GETMOUSEKEYS, SPI_GETSERIALKEYS, SPI_GETSTICKYKEYS, SPI_GETTOGGLEKEYS,
                      SPI_GETFOCUSBORDERHEIGHT, SPI_GETFOCUSBORDERWIDTH, SPI_GETMOUSECLICKLOCK, SPI_GETMOUSECLICKLOCKTIME,
                      SPI_GETMOUSESONAR, SPI_GETMOUSEVANISH, SPI_GETSCREENREADER, SPI_GETSHOWSOUNDS,
                      SPI_GETDESKWALLPAPER, SPI_GETDROPSHADOW, SPI_GETFLATMENU, SPI_GETFONTSMOOTHING,
                      SPI_GETFONTSMOOTHINGCONTRAST, SPI_GETFONTSMOOTHINGTYPE, SPI_GETWORKAREA,
                      0{SPI_SETCURSORS}, 0{SPI_SETDESKPATTERN},
                      SPI_GETICONMETRICS, SPI_GETICONTITLELOGFONT, SPI_GETICONTITLEWRAP,
                      SPI_ICONHORIZONTALSPACING, SPI_ICONVERTICALSPACING, 0{SPI_SETICONS},
                      SPI_GETBEEP, SPI_GETBLOCKSENDINPUTRESETS, SPI_GETDEFAULTINPUTLANG,
                      SPI_GETKEYBOARDCUES, SPI_GETKEYBOARDDELAY, SPI_GETKEYBOARDPREF, SPI_GETKEYBOARDSPEED,
                      SPI_GETMOUSE, SPI_GETMOUSEHOVERHEIGHT, SPI_GETMOUSEHOVERTIME, SPI_GETMOUSEHOVERWIDTH,
                      SPI_GETMOUSESPEED, SPI_GETMOUSETRAILS, SPI_GETSNAPTODEFBUTTON, SPI_GETWHEELSCROLLLINES,
                      0{SPI_SETLANGTOGGLE}, 0{SPI_SETMOUSEBUTTONSWAP},
                      SPI_GETMENUDROPALIGNMENT, SPI_GETMENUFADE, SPI_GETMENUSHOWDELAY,
                      SPI_GETLOWPOWERACTIVE, SPI_GETLOWPOWERTIMEOUT, SPI_GETPOWEROFFACTIVE, SPI_GETPOWEROFFTIMEOUT,
                      SPI_GETSCREENSAVEACTIVE, SPI_GETSCREENSAVERRUNNING, SPI_GETSCREENSAVETIMEOUT,
                      SPI_GETCOMBOBOXANIMATION, SPI_GETCURSORSHADOW, SPI_GETGRADIENTCAPTIONS, SPI_GETHOTTRACKING,
                      SPI_GETLISTBOXSMOOTHSCROLLING, SPI_GETMENUANIMATION, SPI_GETSELECTIONFADE, SPI_GETTOOLTIPANIMATION,
                      SPI_GETTOOLTIPFADE, SPI_GETUIEFFECTS,
                      SPI_GETACTIVEWINDOWTRACKING, SPI_GETACTIVEWNDTRKZORDER, SPI_GETACTIVEWNDTRKTIMEOUT,
                      SPI_GETANIMATION, SPI_GETBORDER, SPI_GETCARETWIDTH, SPI_GETDRAGFULLWINDOWS,
                      SPI_GETFOREGROUNDFLASHCOUNT, SPI_GETFOREGROUNDLOCKTIMEOUT,
                      SPI_GETMINIMIZEDMETRICS, SPI_GETNONCLIENTMETRICS, SPI_GETSHOWIMEUI,
                      0{SPI_SETDRAGHEIGHT}, 0{SPI_SETDRAGWIDTH});
  cSystemSetIndex: array[TSystemParameter] of integer =
                     (SPI_SETACCESSTIMEOUT, SPI_SETFILTERKEYS, SPI_SETHIGHCONTRAST, SPI_SETSOUNDSENTRY,
                      SPI_SETMOUSEKEYS, SPI_SETSERIALKEYS, SPI_SETSTICKYKEYS, SPI_SETTOGGLEKEYS,
                      SPI_SETFOCUSBORDERHEIGHT, SPI_SETFOCUSBORDERWIDTH, SPI_SETMOUSECLICKLOCK, SPI_SETMOUSECLICKLOCKTIME,
                      SPI_SETMOUSESONAR, SPI_SETMOUSEVANISH, SPI_GETSCREENREADER, SPI_SETSHOWSOUNDS,
                      SPI_SETDESKWALLPAPER, SPI_SETDROPSHADOW, SPI_SETFLATMENU, SPI_SETFONTSMOOTHING,
                      SPI_SETFONTSMOOTHINGCONTRAST, SPI_SETFONTSMOOTHINGTYPE, SPI_SETWORKAREA,
                      SPI_SETCURSORS, SPI_SETDESKPATTERN,
                      SPI_SETICONMETRICS, SPI_SETICONTITLELOGFONT, SPI_SETICONTITLEWRAP,
                      SPI_ICONHORIZONTALSPACING, SPI_ICONVERTICALSPACING, SPI_SETICONS,
                      SPI_SETBEEP, SPI_SETBLOCKSENDINPUTRESETS, SPI_SETDEFAULTINPUTLANG,
                      SPI_GETKEYBOARDCUES, SPI_SETKEYBOARDDELAY, SPI_SETKEYBOARDPREF, SPI_SETKEYBOARDSPEED,
                      SPI_SETMOUSE, SPI_SETMOUSEHOVERHEIGHT, SPI_SETMOUSEHOVERTIME, SPI_SETMOUSEHOVERWIDTH,
                      SPI_SETMOUSESPEED, SPI_SETMOUSETRAILS, SPI_SETSNAPTODEFBUTTON, SPI_SETWHEELSCROLLLINES,
                      SPI_SETLANGTOGGLE, SPI_SETMOUSEBUTTONSWAP,
                      SPI_SETMENUDROPALIGNMENT, SPI_SETMENUFADE, SPI_SETMENUSHOWDELAY,
                      SPI_SETLOWPOWERACTIVE, SPI_SETLOWPOWERTIMEOUT, SPI_SETPOWEROFFACTIVE, SPI_SETPOWEROFFTIMEOUT,
                      SPI_SETSCREENSAVEACTIVE, SPI_SETSCREENSAVERRUNNING, SPI_SETSCREENSAVETIMEOUT,
                      SPI_SETCOMBOBOXANIMATION, SPI_SETCURSORSHADOW, SPI_SETGRADIENTCAPTIONS, SPI_SETHOTTRACKING,
                      SPI_SETLISTBOXSMOOTHSCROLLING, SPI_SETMENUANIMATION, SPI_SETSELECTIONFADE, SPI_SETTOOLTIPANIMATION,
                      SPI_SETTOOLTIPFADE, SPI_SETUIEFFECTS,
                      SPI_SETACTIVEWINDOWTRACKING, SPI_SETACTIVEWNDTRKZORDER, SPI_SETACTIVEWNDTRKTIMEOUT,
                      SPI_SETANIMATION, SPI_SETBORDER, SPI_SETCARETWIDTH, SPI_SETDRAGFULLWINDOWS,
                      SPI_SETFOREGROUNDFLASHCOUNT, SPI_SETFOREGROUNDLOCKTIMEOUT,
                      SPI_SETMINIMIZEDMETRICS, SPI_SETNONCLIENTMETRICS, SPI_SETSHOWIMEUI,
                      SPI_SETDRAGHEIGHT, SPI_SETDRAGWIDTH);

{ ------------------------------------------------------------------------------------------------ }
type
  TSPIFlag = (spfUpdateProfile, spfBroadcastChanges);
  TSPIFlags = set of TSPIFlag;
const
  cSPIFlags: array[TSPIFlag] of cardinal = (SPIF_UPDATEINIFILE, SPIF_SENDCHANGE);

{ ------------------------------------------------------------------------------------------------ }
type
  TSystemParametersInfo = class
  private
    FFlags: cardinal;

    function  GetFlags: TSPIFlags;
    procedure SetFlags(const Value: TSPIFlags);
    function  GetFlag(const Index: integer): boolean;
    procedure SetFlag(const Index: integer; const Value: boolean);

    function  GetBoolean(const Parameter: TSystemParameter): Boolean;
    procedure SetBoolean(const Parameter: TSystemParameter; const Value: Boolean);
    function  GetCardinal(const Parameter: TSystemParameter): Cardinal;
    procedure SetCardinal(const Parameter: TSystemParameter; const Value: Cardinal);
    function  GetInteger(const Parameter: TSystemParameter): Integer;
    procedure SetInteger(const Parameter: TSystemParameter; const Value: Integer);
    function  GetString(const Parameter: TSystemParameter): string;
    procedure SetString(const Parameter: TSystemParameter; const Value: string);
    procedure GetByPointer(const Parameter: TSystemParameter; Value: Pointer; Size: Cardinal);
    procedure SetByPointer(const Parameter: TSystemParameter; Value: Pointer; Size: Cardinal);

    function  GetFont(const Parameter: TSystemParameter): TFont;
    procedure SetFont(const Parameter: TSystemParameter; const Value: TFont);

    function  GetAccessTimeout(const Parameter: TSystemParameter): TAccessTimeout;
    procedure SetAccessTimeout(const Parameter: TSystemParameter; Value: TAccessTimeout);
    function  GetAnimationInfo(const Parameter: TSystemParameter): TAnimationInfo;
    procedure SetAnimationInfo(const Parameter: TSystemParameter; Value: TAnimationInfo);
    function  GetFilterKeys(const Parameter: TSystemParameter): TFilterKeys;
    procedure SetFilterKeys(const Parameter: TSystemParameter; Value: TFilterKeys);
    function  GetHighContrast(const Parameter: TSystemParameter): THighContrast;
    procedure SetHighContrast(const Parameter: TSystemParameter; Value: THighContrast);
    function  GetIconMetrics(const Parameter: TSystemParameter): TIconMetrics;
    procedure SetIconMetrics(const Parameter: TSystemParameter; Value: TIconMetrics);
    function  GetMinimizedMetrics(const Parameter: TSystemParameter): TMinimizedMetrics;
    procedure SetMinimizedMetrics(const Parameter: TSystemParameter; Value: TMinimizedMetrics);
    function  GetNonClientMetrics(const Parameter: TSystemParameter): TNonClientMetrics;
    procedure SetNonClientMetrics(const Parameter: TSystemParameter; Value: TNonClientMetrics);
    function  GetRect(const Parameter: TSystemParameter): TRect;
    procedure SetRect(const Parameter: TSystemParameter; Value: TRect);
    function  GetSoundSentry(const Parameter: TSystemParameter): TSoundSentry;
    procedure SetSoundSentry(const Parameter: TSystemParameter; Value: TSoundSentry);
    function  GetMouseKeys(const Parameter: TSystemParameter): TMouseKeys;
    procedure SetMouseKeys(const Parameter: TSystemParameter; Value: TMouseKeys);
    function  GetSerialKeys(const Parameter: TSystemParameter): TSerialKeys;
    procedure SetSerialKeys(const Parameter: TSystemParameter; Value: TSerialKeys);
    function  GetStickyKeys(const Parameter: TSystemParameter): TStickyKeys;
    procedure SetStickyKeys(const Parameter: TSystemParameter; Value: TStickyKeys);
    function  GetToggleKeys(const Parameter: TSystemParameter): TToggleKeys;
    procedure SetToggleKeys(const Parameter: TSystemParameter; Value: TToggleKeys);

  public
    procedure Reset(const Parameter: TSystemParameter);

    property Flags: TSPIFlags                                         read GetFlags     write SetFlags;
    property UpdateProfile: boolean       index SPIF_UPDATEINIFILE    read GetFlag      write SetFlag;
    property BroadcastChange: boolean     index SPIF_SENDCHANGE       read GetFlag      write SetFlag;

    property AsBoolean[const Parameter: TSystemParameter]: Boolean    read GetBoolean   write SetBoolean;
    property AsInteger[const Parameter: TSystemParameter]: Integer    read GetInteger   write SetInteger;
    property AsCardinal[const Parameter: TSystemParameter]: Cardinal  read GetCardinal  write SetCardinal;
    property AsString[const Parameter: TSystemParameter]: string      read GetString    write SetString;

    // Accessibility
    property AccessTimeout: TAccessTimeout    index spAccessTimeout           read GetAccessTimeout write SetAccessTimeout;
    property FilterKeys: TFilterKeys          index spFilterKeys              read GetFilterKeys    write SetFilterKeys;
    property FocusBorderHeight: Cardinal      index spFocusBorderHeight       read GetCardinal      write SetCardinal;
    property FocusBorderWidth: Cardinal       index spFocusBorderWidth        read GetCardinal      write SetCardinal;
    property HighContrast: THighContrast      index spHighContrast            read GetHighContrast  write SetHighContrast;
    property MouseClickLock: Boolean          index spMouseClickLock          read GetBoolean       write SetBoolean;
    property MouseClickLockTime: Cardinal     index spMouseClickLockTime      read GetCardinal      write SetCardinal;
    property MouseKeys: TMouseKeys            index spMouseKeys               read GetMouseKeys     write SetMouseKeys;
    property MouseSonar: Boolean              index spMouseSonar              read GetBoolean       write SetBoolean;
    property MouseVanish: Boolean             index spMouseVanish             read GetBoolean       write SetBoolean;
    property ScreenReader: Boolean            index spScreenReader            read GetBoolean       write SetBoolean;
    property SerialKeys: TSerialKeys          index spSerialKeys              read GetSerialKeys    write SetSerialKeys;
    property ShowSounds: Boolean              index spShowSounds              read GetBoolean       write SetBoolean;
    property SoundSentry: TSoundSentry        index spSoundSentry             read GetSoundSentry   write SetSoundSentry;
    property StickyKeys: TStickyKeys          index spStickyKeys              read GetStickyKeys    write SetStickyKeys;
    property ToggleKeys: TToggleKeys          index spToggleKeys              read GetToggleKeys    write SetToggleKeys;

    // Desktop
    property DeskWallpaper: string            index spDeskWallpaper           read GetString      write SetString;
    property DropShadow: Boolean              index spDropShadow              read GetBoolean     write SetBoolean;
    property FlatMenu: Boolean                index spFlatMenu                read GetBoolean     write SetBoolean;
    property FontSmoothing: Boolean           index spFontSmoothing           read GetBoolean     write SetBoolean;
    property FontSmoothingContrast: Cardinal  index spFontSmoothingContrast   read GetCardinal    write SetCardinal;
    property FontSmoothingType: Cardinal      index spFontSmoothingType       read GetCardinal    write SetCardinal;
    property WorkArea: TRect                  index spWorkArea                read GetRect        write SetRect;
    property IconMetrics: TIconMetrics        index spIconMetrics             read GetIconMetrics write SetIconMetrics;
    property IconTitleFont: TFont             index spIconTitleFont           read GetFont        write SetFont;
    property IconTitleWrap: Boolean           index spIconTitleWrap           read GetBoolean     write SetBoolean;
    property IconHorizontalSpacing: Cardinal  index spIconHorizontalSpacing   read GetCardinal    write SetCardinal;
    property IconVerticalSpacing: Cardinal    index spIconVerticalSpacing     read GetCardinal    write SetCardinal;

    // Input
    property Beep: Boolean                    index spBeep                    read GetBoolean   write SetBoolean;
    property BlockSendInputRequests: Boolean  index spBlockSendInputResets    read GetBoolean   write SetBoolean;
    property DefaultInputLang: Cardinal       index spDefaultInputLang        read GetCardinal  write SetCardinal;
    property KeyboardCues: Boolean            index spKeyboardCues            read GetBoolean   write SetBoolean;
    property KeyboardDelay: Cardinal          index spKeyboardDelay           read GetCardinal  write SetCardinal;
    property KeyboardPreferred: Boolean       index spKeyboardPreferred       read GetBoolean   write SetBoolean;
    property KeyboardSpeed: Cardinal          index spKeyboardSpeed           read GetCardinal  write SetCardinal;
    // spMouse
    property MouseHoverHeight: Cardinal       index spMouseHoverHeight        read GetCardinal  write SetCardinal;
    property MouseHoverTime: Cardinal         index spMouseHoverTime          read GetCardinal  write SetCardinal;
    property MouseHoverWidth: Cardinal        index spMouseHoverWidth         read GetCardinal  write SetCardinal;
    property MouseSpeed: Integer              index spMouseSpeed              read GetInteger   write SetInteger;
    property MouseTrails: Integer             index spMouseTrails             read GetInteger   write SetInteger;
    property SnapToDefButton: Boolean         index spSnapToDefButton         read GetBoolean   write SetBoolean;
    property WheelScrollLines: Cardinal       index spWheelScrollLines        read GetCardinal  write SetCardinal;
    property MouseButtonSwap: Boolean         index spMouseButtonSwap                           write SetBoolean;

    // Menus
    property MenuDropAlignment: Boolean       index spMenuDropAlignment       read GetBoolean   write SetBoolean;
    property MenuFade: Boolean                index spMenuFade                read GetBoolean   write SetBoolean;
    property MenuShowDelay: Cardinal          index spMenuShowDelay           read GetCardinal  write SetCardinal;

    // Power
    property LowPowerActive: Boolean          index spLowPowerActive          read GetBoolean   write SetBoolean;
    property LowPowerTimeout: Integer         index spLowPowerTimeout         read GetInteger   write SetInteger;
    property PowerOffActive: Boolean          index spPowerOffActive          read GetBoolean   write SetBoolean;
    property PowerOffTimeout: Integer         index spPowerOffTimeout         read GetInteger   write SetInteger;

    // Screen saver
    property ScreenSaveSet: Boolean           index spScreenSaveSet           read GetBoolean   write SetBoolean;
    property ScreenSaverRunning: Boolean      index spScreenSaverRunning      read GetBoolean   write SetBoolean;
    property ScreenSaveTimeout: Cardinal      index spScreenSaveTimeout       read GetCardinal  write SetCardinal;

    // UI effects
    property ComboBoxAnimation: Boolean       index spComboBoxAnimation       read GetBoolean   write SetBoolean;
    property CursorShadow: Boolean            index spCursorShadow            read GetBoolean   write SetBoolean;
    property GradientCaptions: Boolean        index spGradientCaptions        read GetBoolean   write SetBoolean;
    property Hottracking: Boolean             index spHottracking             read GetBoolean   write SetBoolean;
    property ListboxSmoothScrolling: Boolean  index spListboxSmoothScrolling  read GetBoolean   write SetBoolean;
    property MenuAnimation: Boolean           index spMenuAnimation           read GetBoolean   write SetBoolean;
    property SelectionFade: Boolean           index spSelectionFade           read GetBoolean   write SetBoolean;
    property TooltipAnimation: Boolean        index spTooltipAnimation        read GetBoolean   write SetBoolean;
    property TooltipFade: Boolean             index spTooltipFade             read GetBoolean   write SetBoolean;
    property UIEffects: Boolean               index spAllUIEffects            read GetBoolean   write SetBoolean;

    // Window
    property ActiveWindowTracking: Boolean        index spActiveWindowTracking    read GetBoolean           write SetBoolean;
    property ActiveWndTrkZOrder: Boolean          index spActiveWndTrkZOrder      read GetBoolean           write SetBoolean;
    property ActiveWndTrkTimeout: Cardinal        index spActiveWndTrkTimeout     read GetCardinal          write SetCardinal;
    property Animation: TAnimationInfo            index spAnimation               read GetAnimationInfo     write SetAnimationInfo;
    property Border: Integer                      index spBorder                  read GetInteger           write SetInteger;
    property CaretWidth: Cardinal                 index spCaretWidth              read GetCardinal          write SetCardinal;
    property DragFullWindows: Boolean             index spDragFullWindows         read GetBoolean           write SetBoolean;
    property ForegroundFlashCount: Cardinal       index spForegroundFlashCount    read GetCardinal          write SetCardinal;
    property ForegroundLockTimeout: Cardinal      index spForegroundLockTimeout   read GetCardinal          write SetCardinal;
    property MinimizedMetrics: TMinimizedMetrics  index spMinimizedMetrics        read GetMinimizedMetrics  write SetMinimizedMetrics;
    property NonClientMetrics: TNonClientMetrics  index spNonClientMetrics        read GetNonClientMetrics  write SetNonClientMetrics;
    property ShowIMEUI: Boolean                   index spShowIMEUI               read GetBoolean           write SetBoolean;
    property DragHeight: Boolean                  index spDragHeight                                        write SetBoolean;
    property DragWidth: Boolean                   index spDragWidth                                         write SetBoolean;
  end;

var
  SystemParameters: TSystemParametersInfo;

////////////////////////////////////////////////////////////////////////////////////////////////////
implementation
uses
  SysUtils, System.UItypes;

{ ================================================================================================ }
{ TSystemParametersInfo }

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetFlag(const Index: integer): boolean;
begin
  Result := 0 <> (FFlags and Cardinal(Index));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetFlag(const Index: integer; const Value: boolean);
begin
  if Value then begin
    FFlags := FFlags or Cardinal(Index);
  end else begin
    FFlags := FFlags and not Cardinal(Index);
  end;
end;


{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetFlags: TSPIFlags;
var
  Flag: TSPIFlag;
begin
  Result := [];
  for Flag := Low(cSPIFlags) to High(cSPIFlags) do begin
    if Boolean(FFlags and cSPIFlags[Flag]) then begin
      Include(Result, Flag);
    end;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetFlags(const Value: TSPIFlags);
var
  Flags: Cardinal;
  Flag: TSPIFlag;
begin
  Flags := 0;
  for Flag := Low(cSPIFlags) to High(cSPIFlags) do begin
    if Flag in Value then begin
      Flags := Flags or cSPIFlags[Flag];
    end;
  end;
  FFlags := Flags;
end;


{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.Reset(const Parameter: TSystemParameter);
begin
  SystemParametersInfo(cSystemSetIndex[Parameter], 0, nil, FFlags);
end;


{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetBoolean(const Parameter: TSystemParameter): Boolean;
begin
  Result := Boolean(GetCardinal(Parameter));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetBoolean(const Parameter: TSystemParameter; const Value: Boolean);
begin
  SetCardinal(Parameter, Cardinal(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.GetByPointer(const Parameter: TSystemParameter; Value: Pointer;
  Size: Cardinal);
begin
  if not SystemParametersInfo(cSystemGetIndex[Parameter], Size, Value, 0) then begin
    RaiseLastOSError;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetByPointer(const Parameter: TSystemParameter; Value: Pointer;
  Size: Cardinal);
begin
  if not SystemParametersInfo(cSystemSetIndex[Parameter], Size, Value, FFlags) then begin
    RaiseLastOSError;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetCardinal(const Parameter: TSystemParameter): Cardinal;
begin
  if not SystemParametersInfo(cSystemGetIndex[Parameter], 0, @Result, 0) then begin
    RaiseLastOSError;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetCardinal(const Parameter: TSystemParameter; const Value: Cardinal);
begin
  if cSystemGetIndex[Parameter] <> cSystemSetIndex[Parameter] then begin
    if not SystemParametersInfo(cSystemSetIndex[Parameter], Value, @Value, FFlags) then begin
      RaiseLastOSError;
    end
  end else begin
    if not SystemParametersInfo(cSystemSetIndex[Parameter], Value, nil, FFlags) then begin
      RaiseLastOSError;
    end;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetInteger(const Parameter: TSystemParameter): Integer;
begin
  Result := Integer(GetCardinal(Parameter));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetInteger(const Parameter: TSystemParameter; const Value: Integer);
begin
  SetCardinal(Parameter, Cardinal(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetString(const Parameter: TSystemParameter): string;
begin
  Result := StringOfChar(#0, MAX_PATH);
  if not SystemParametersInfo(cSystemGetIndex[Parameter], Length(Result), PChar(Result), 0) then begin
    RaiseLastOSError;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetString(const Parameter: TSystemParameter; const Value: string);
begin
  if not SystemParametersInfo(cSystemSetIndex[Parameter], Length(Value), PChar(Value), FFlags) then begin
    RaiseLastOSError;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetAccessTimeout(const Parameter: TSystemParameter): TAccessTimeout;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetAccessTimeout(const Parameter: TSystemParameter; Value: TAccessTimeout);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetAnimationInfo(const Parameter: TSystemParameter): TAnimationInfo;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetAnimationInfo(const Parameter: TSystemParameter; Value: TAnimationInfo);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetFilterKeys(const Parameter: TSystemParameter): TFilterKeys;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetFilterKeys(const Parameter: TSystemParameter; Value: TFilterKeys);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetHighContrast(const Parameter: TSystemParameter): THighContrast;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetHighContrast(const Parameter: TSystemParameter; Value: THighContrast);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetIconMetrics(const Parameter: TSystemParameter): TIconMetrics;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetIconMetrics(const Parameter: TSystemParameter; Value: TIconMetrics);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetMinimizedMetrics(const Parameter: TSystemParameter): TMinimizedMetrics;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetMinimizedMetrics(const Parameter: TSystemParameter; Value: TMinimizedMetrics);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetNonClientMetrics(const Parameter: TSystemParameter): TNonClientMetrics;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetNonClientMetrics(const Parameter: TSystemParameter; Value: TNonClientMetrics);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetRect(const Parameter: TSystemParameter): TRect;
begin
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetRect(const Parameter: TSystemParameter; Value: TRect);
begin
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetSoundSentry(const Parameter: TSystemParameter): TSoundSentry;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetSoundSentry(const Parameter: TSystemParameter; Value: TSoundSentry);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetMouseKeys(const Parameter: TSystemParameter): TMouseKeys;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetMouseKeys(const Parameter: TSystemParameter; Value: TMouseKeys);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetSerialKeys(const Parameter: TSystemParameter): TSerialKeys;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetSerialKeys(const Parameter: TSystemParameter; Value: TSerialKeys);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetStickyKeys(const Parameter: TSystemParameter): TStickyKeys;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetStickyKeys(const Parameter: TSystemParameter; Value: TStickyKeys);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetToggleKeys(const Parameter: TSystemParameter): TToggleKeys;
begin
  Result.cbSize := SizeOf(Result);
  GetByPointer(Parameter, @Result, SizeOf(Result));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetToggleKeys(const Parameter: TSystemParameter; Value: TToggleKeys);
begin
  Value.cbSize := SizeOf(Value);
  SetByPointer(Parameter, @Value, SizeOf(Value));
end;


{ ------------------------------------------------------------------------------------------------ }
function TSystemParametersInfo.GetFont(const Parameter: TSystemParameter): TFont;
var
  LogFont: TLogFont;
begin
  GetByPointer(Parameter, @LogFont, sizeof(LogFont));
  Result := TFont.Create;
  Result.Handle := CreateFontIndirect(LogFont);
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSystemParametersInfo.SetFont(const Parameter: TSystemParameter; const Value: TFont);
const
  cBoldWeight: array[False..True] of Integer = (FW_NORMAL, FW_BOLD);
var
  LogFont: TLogFont;
begin
  with LogFont do begin
    StrCopy(lfFaceName, PChar(Value.Name));
    lfHeight := Value.Height;
    lfCharSet := Value.Charset;
    lfWeight := cBoldWeight[fsBold in Value.Style];
    lfItalic := Ord(fsItalic in Value.Style);
    lfUnderline := Ord(fsUnderline in Value.Style);
    lfStrikeOut := Ord(fsStrikeOut in Value.Style);
  end;
  SetByPointer(Parameter, @LogFont, SizeOf(LogFont));
end;


////////////////////////////////////////////////////////////////////////////////////////////////////
initialization
  SystemParameters := TSystemParametersInfo.Create;
  SystemParameters.Flags := [spfUpdateProfile, spfBroadcastChanges];

finalization
  SystemParameters.Free;

end.

Added src/M_Actions.dfm.





















































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
object modActions: TmodActions
  OldCreateOrder = False
  OnCreate = DataModuleCreate
  OnDestroy = DataModuleDestroy
  Height = 420
  Width = 542
  object actmgrMain: TActionManager
    ActionBars = <
      item
        Items = <
          item
            Action = actFolderAdd
            Caption = '&Add folder...'
            ImageIndex = 0
          end
          item
            Action = actFolderRemove
            Caption = '&Remove folder'
            ImageIndex = 1
          end>
        ActionBar = frmFolderWatcher.acttbFolders
      end
      item
        Items = <
          item
            Action = actCustomize
          end>
        ActionBar = frmFolderWatcher.acttbWatchers
      end
      item
      end>
    Images = imlMain
    Left = 32
    Top = 136
    StyleName = 'Platform Default'
    object actFolderAdd: TBrowseForFolder
      Category = 'Folder'
      Caption = 'Add folder...'
      DialogCaption = 'Select folder to watch'
      BrowseOptions = [bifEditBox, bifNewDialogStyle, bifReturnOnlyFSDirs, bifUseNewUI]
      BrowseOptionsEx = [bifeAllowMultiselect]
      ImageIndex = 0
      OnAccept = actFolderAddAccept
    end
    object actFolderRemove: TAction
      Category = 'Folder'
      Caption = 'Remove folder'
      Enabled = False
      ImageIndex = 1
    end
    object actCustomize: TCustomizeActionBars
      Category = 'Tools'
      Caption = '&Customize...'
      ActionManager = actmgrMain
      CustomizeDlg.StayOnTop = True
    end
  end
  object imlMain: TImageList
    ColorDepth = cd32Bit
    Left = 96
    Top = 136
    Bitmap = {
      494C0101020008001C0010001000FFFFFFFF2110FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000400000001000000001002000000000000010
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000465D4E88216A
      3CF2166834FF216A3CF2465D4E88000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000045526A781D4E
      A8DF0340BAFE1A4EABE33F4F697A000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000455B4D84258B50FF61B9
      8CFF94D2B1FF61B98CFF258B50FF465E4F8C0000000000000000000000000000
      00000000000000000000000000000000000000000000465570802663C7FB1E74
      E6FF0376EAFF0061DDFF054BBBFC3F4F697A0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000465868704C7395A63784
      C9EA3087D2F73087D2F73087D2F73087D2F73087D2F7196A3BFF5FB98AFF5DB9
      86FFFFFFFFFF5DB886FF64BB8EFF1D6A39F700000000465868704C7395A63784
      C9EA3087D2F73087D2F73087D2F73087D2F73087D2F7064ABAFE609CF4FF157C
      FFFF0073F8FF0073EEFF0165E1FF194DABE40000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003D89C6E6D1E1EBF0A6DB
      F2FD9DDBF4FF95DAF3FF8DD8F3FF85D7F3FF7CD4F2FF2E7849FF9BD4B5FFFFFF
      FFFFFFFFFFFFFFFFFFFF94D2B1FF166834FF000000003D89C6E6D1E1EBF0A6DB
      F2FD9DDBF4FF95DAF3FF8DD8F3FF85D7F3FF7CD4F2FF0240BBFFADCDFEFFFFFF
      FFFFFFFFFFFFFFFFFFFF157CEFFF0340BAFE0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003791D4F7EFFAFEFFA0E9
      F9FF90E5F8FF80E1F7FF6FDEF6FF60DAF5FF51D7F4FF41885FFF8FD3B0FF91D6
      B0FFFFFFFFFF62BB8BFF64BB8EFF1D6A39F7000000003791D4F7EFFAFEFFA0E9
      F9FF90E5F8FF80E1F7FF6FDEF6FF60DAF5FF51D7F4FF0A54C0FF8CB4F6FF4A91
      FFFF0F74FFFF1E85FFFF3D89EBFF1E4EA8DE0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003898D5F8F2FAFDFFB2ED
      FAFFA3E9F9FF94E6F8FF84E2F7FF73DEF6FF62DBF5FF51B2ADFF5EAA80FF94D4
      B3FFB9E6D0FF67BA8EFF2A8E54FF465E4F8C000000003898D5F8F2FAFDFFB2ED
      FAFFA3E9F9FF94E6F8FF84E2F7FF73DEF6FF62DBF5FF399ADEFF3572D2FF8CB4
      F7FFB7D6FEFF6FA7F5FF2A69CBFF3F4A606D0000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000379ED5F9F6FCFEFFC8F2
      FCFFB8EFFBFFABECFAFF9BE8F9FF8AE3F7FF79E0F6FF69DCF6FF58B6B3FF5596
      72FF4C8D63FF44895EFF328B91FB0000000000000000379ED5F9F6FCFEFFC8F2
      FCFFB8EFFBFFABECFAFF9BE8F9FF8AE3F7FF79E0F6FF69DCF6FF3C9BDEFF135A
      C5FF0240BBFF1756C0FF1E71C8FB000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000037A4D5FAFEFFFFFFF8FD
      FFFFF6FDFFFFF5FCFFFFF3FCFEFFD8F6FCFF93E6F8FF84E3F7FF73DFF6FF65DB
      F5FF59D8F4FFD7F4FCFF37A1D4F7000000000000000037A4D5FAFEFFFFFFF8FD
      FFFFF6FDFFFFF5FCFFFFF3FCFEFFD8F6FCFF93E6F8FF84E3F7FF73DFF6FF65DB
      F5FF59D8F4FFD7F4FCFF37A1D4F7000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000035A7D5FAE8F6FBFF93D4
      EFFF87CEEEFF70C0E9FFC9E9F6FFF2FCFEFFF3FCFEFFF2FCFEFFF0FCFEFFEFFB
      FEFFEEFBFEFFFEFFFFFF38A6D4F7000000000000000035A7D5FAE8F6FBFF93D4
      EFFF87CEEEFF70C0E9FFC9E9F6FFF2FCFEFFF3FCFEFFF2FCFEFFF0FCFEFFEFFB
      FEFFEEFBFEFFFEFFFFFF38A6D4F7000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003BA4D0F2F1FAFDFF93DE
      F5FF92DCF4FF80D5F2FF67CAEDFF69CBEAFF84D3EFFF7DD2EFFF77D0EFFF73CF
      EEFF6FCFEEFFE9F7FBFF38A8D0F300000000000000003BA4D0F2F1FAFDFF93DE
      F5FF92DCF4FF80D5F2FF67CAEDFF69CBEAFF84D3EFFF7DD2EFFF77D0EFFF73CF
      EEFF6FCFEEFFE9F7FBFF38A8D0F3000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000003BA8CFF0F7FCFEFF8DE4
      F8FF90DEF5FF9EE0F5FFABE1F6FFEFFBFEFFF4FDFEFFF3FCFEFFF1FCFEFFEFFB
      FEFFEEFBFEFFF4F7F9F9479BBAD400000000000000003BA8CFF0F7FCFEFF8DE4
      F8FF90DEF5FF9EE0F5FFABE1F6FFEFFBFEFFF4FDFEFFF3FCFEFFF1FCFEFFEFFB
      FEFFEEFBFEFFF4F7F9F9479BBAD4000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000038AFD5F8FDFEFEFFFEFF
      FFFFFEFEFFFFFDFEFFFFFEFFFFFFEAF7FBFF6AC3DEF969C2DCF869C2DCF869C2
      DCF876C7DEF773B7CCE13E4C5156000000000000000038AFD5F8FDFEFEFFFEFF
      FFFFFEFEFFFFFDFEFFFFFEFFFFFFEAF7FBFF6AC3DEF969C2DCF869C2DCF869C2
      DCF876C7DEF773B7CCE13E4C5156000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000479DB6D05CBEDCFA5EBF
      DDFA5EBFDDFA5EBFDDFA5DBFDDFA48A5C1DD141515160E0E0E0F0E0E0E0F0E0E
      0E0F0E0E0E0F0E0E0E0F030303040000000000000000479DB6D05CBEDCFA5EBF
      DDFA5EBFDDFA5EBFDDFA5DBFDDFA48A5C1DD141515160E0E0E0F0E0E0E0F0E0E
      0E0F0E0E0E0F0E0E0E0F03030304000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000424D3E000000000000003E000000
      2800000040000000100000000100010000000000800000000000000000000000
      000000000000000000000000FFFFFF00FFC1FFC100000000FF80FF8000000000
      8000800000000000800080000000000080008000000000008000800000000000
      8001800100000000800180010000000080018001000000008001800100000000
      800180010000000080018001000000008001800100000000FFFFFFFF00000000
      FFFFFFFF00000000FFFFFFFF0000000000000000000000000000000000000000
      000000000000}
  end
end

Added src/M_Actions.pas.















































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
unit M_Actions;

interface

uses
  Classes, ImageList, Actions, Generics.Collections, IniFiles,
  Vcl.ImgList, Vcl.Controls, Vcl.BandActn, Vcl.ActnList, Vcl.StdActns,
  Vcl.PlatformDefaultStyleActnCtrls, Vcl.ActnMan,
  FileSystemWatcher;

type
  TFileEvent = record
    FileOperation: TFileOperation;
    FileName1, FileName2: string;
  end;

  TmodActions = class(TDataModule)
    actmgrMain: TActionManager;
    actFolderAdd: TBrowseForFolder;
    actFolderRemove: TAction;
    actCustomize: TCustomizeActionBars;
    imlMain: TImageList;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure WatchersNotify(Sender: TObject; const Watcher: TFileSystemWatcher; Action: TCollectionNotification);
    procedure FileSystemChange(Sender: TFileSystemWatcher; FileOperation: TFileOperation; const FileName1, FileName2: string);
    procedure actFolderAddAccept(Sender: TObject);
  private
    { Private declarations }
    FWatchers: TObjectList<TFileSystemWatcher>;
    FHandlers: TList<TCollectionNotifyEvent<TFileSystemWatcher>>;
    FSettings: TCustomIniFile;

    procedure LoadActions;
    procedure SaveActions;

    function AddFolder(const Folder: string): TFileSystemWatcher;

    function StrToNotifyFilters(const NotifyFilters: string): TNotifyFilters;
    function NotifyFiltersToStr(const NotifyFilters: TNotifyFilters): string;
  public
    { Public declarations }
    function AddHandler(const Handler: TCollectionNotifyEvent<TFileSystemWatcher>): Integer;
    function RemoveHandler(const Handler: TCollectionNotifyEvent<TFileSystemWatcher>): Integer;

    procedure LoadWatcherSettings(const Watcher: TFileSystemWatcher);
    procedure SaveWatcherSettings(const Watcher: TFileSystemWatcher);

    property Settings: TCustomIniFile                   read FSettings;
    property Watchers: TObjectList<TFileSystemWatcher>  read FWatchers;
  end;

var
  modActions: TmodActions;

implementation
uses
  SysUtils, IOUtils, ZLib,
  Vcl.Forms,
  L_SpecialFolders,
  FMain, System.TypInfo, Vcl.ComCtrls;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

procedure TmodActions.DataModuleCreate(Sender: TObject);
var
  Folders: TStringList;
  Folder: string;
  Watcher: TFileSystemWatcher;
begin
  FWatchers := TObjectList<TFileSystemWatcher>.Create;
  FWatchers.OnNotify := WatchersNotify;

  FHandlers := TList<TCollectionNotifyEvent<TFileSystemWatcher>>.Create;
  AddHandler(frmFolderWatcher.WatchersNotify);

  FSettings := TIniFile.Create(TPath.Combine(TSpecialFolders.Settings, Application.Name + '.ini'));

  LoadActions;

  actFolderRemove.OnExecute := frmFolderWatcher.actFolderRemoveExecute;

  Folders := TStringList.Create;
  try
    FSettings.ReadSection('Folders', Folders);
    for Folder in Folders do begin
      Watcher := AddFolder(Folder);
      Watcher.Enabled := FSettings.ReadBool('Folders', Folder, False);
    end;
  finally
    Folders.Free;
  end;
end;

procedure TmodActions.DataModuleDestroy(Sender: TObject);
begin
  try
    SaveActions;
  finally
    FHandlers.Free;
    FWatchers.Free;
    FSettings.Free;
  end;
end;

procedure TmodActions.FileSystemChange(Sender: TFileSystemWatcher; FileOperation: TFileOperation;
                                       const FileName1, FileName2: string);
const
  ISO: TFormatSettings = (DateSeparator: '-'; TimeSeparator: ':';
                          ShortDateFormat: 'yyyy-MM-dd';
                          LongTimeFormat: 'hh:nn:ss.zzz');
var
  Path: string;
  Item: TListItem;
  i: Integer;
begin
  Path := IncludeTrailingPathDelimiter(Sender.WatchedDir);
  // TODO
  Item := frmFolderWatcher.lvwLog.Items.Add;
  Item.Caption := DateTimeToStr(Now, ISO);
  Item.SubItems.Add(GetEnumName(TypeInfo(TFileOperation), Ord(FileOperation)).Substring(2));
  if FileName1.StartsWith(Path) then
    Item.SubItems.Add(FileName1.Substring(Path.Length))
  else
    Item.SubItems.Add(FileName1);
  if FileName2.StartsWith(Path) then
    Item.SubItems.Add(FileName2.Substring(Path.Length))
  else
    Item.SubItems.Add(FileName2);
  Item.SubItems.Add(Sender.WatchedDir);
  Item.MakeVisible(False);

  for i := 0 to frmFolderWatcher.lvwLog.Columns.Count - 1 do
    frmFolderWatcher.lvwLog.Columns.Items[i].Width := -1;
end;

procedure TmodActions.actFolderAddAccept(Sender: TObject);
begin
  AddFolder(actFolderAdd.Folder);
end;

function TmodActions.AddFolder(const Folder: string): TFileSystemWatcher;
begin
  Result := TFileSystemWatcher.Create(nil);
  Result.OnChange := FileSystemChange;
  Result.WatchedDir := Folder;
  LoadWatcherSettings(Result);
  FWatchers.Add(Result);
end;

function TmodActions.AddHandler(const Handler: TCollectionNotifyEvent<TFileSystemWatcher>): integer;
begin
  Result := FHandlers.Add(Handler);
end;

function TmodActions.RemoveHandler(const Handler: TCollectionNotifyEvent<TFileSystemWatcher>): integer;
begin
  Result := FHandlers.Remove(Handler);
end;

function GetConfigFileName: string;
const
  cConfigFilename = 'UI.cfg';
begin
  Result := TPath.Combine(TSpecialFolders.Settings, cConfigFilename);
end;

procedure TmodActions.LoadActions;
const
  cMarker = 'object';
var
  FileName: string;
  FileStream, MemStream, ZipStream: TStream;
  Bytes: TBytes;
  MarkerLength: Integer;
  Size: Int64;
begin
  FileName := GetConfigFileName;
  if not FileExists(FileName) then
    Exit;

  FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    MemStream := TMemoryStream.Create;
    try
      MarkerLength := Length(cMarker);
      SetLength(Bytes, MarkerLength);
      if (FileStream.Read(Bytes, MarkerLength) = MarkerLength)
          and CompareMem(@Bytes[0], @TEncoding.UTF8.GetBytes(cMarker)[0], MarkerLength)
      then begin
        FileStream.Position := 0;
        ObjectTextToBinary(FileStream, MemStream);
      end else begin
        FileStream.Position := 0;
        FileStream.ReadData(Size);
        ZipStream := TDecompressionStream.Create(FileStream);
        try
          MemStream.CopyFrom(ZipStream, Size);
        finally
          ZipStream.Free;
        end;
      end;
      MemStream.Position := 0;
      actmgrMain.LoadFromStream(MemStream);
      actmgrMain.ActionBars.SessionCount := actmgrMain.ActionBars.SessionCount + 1;
    finally
      MemStream.Free;
    end;
  finally
    FileStream.Free;
  end;
end;

procedure TmodActions.LoadWatcherSettings(const Watcher: TFileSystemWatcher);
var
  Folder: string;
begin
  Folder := Watcher.WatchedDir;
  Watcher.WatchSubTree := FSettings.ReadBool(Folder, 'Watch subtree', False);
  Watcher.NotifyFilters := StrToNotifyFilters(FSettings.ReadString(Folder, 'Filters', ''));
  if Watcher.NotifyFilters = [] then
    Watcher.NotifyFilters := [Low(TNotifyFilter)..High(TNotifyFilter)];
end;

procedure TmodActions.SaveWatcherSettings(const Watcher: TFileSystemWatcher);
var
  Folder: string;
begin
  Folder := Watcher.WatchedDir;
  FSettings.WriteBool(Folder, 'Watch subtree', Watcher.WatchSubTree);
  FSettings.ReadString(Folder, 'Filters', NotifyFiltersToStr(Watcher.NotifyFilters));
end;

procedure TmodActions.SaveActions;
var
  FileName: string;
  MemStream, FileStream: TStream;
begin
  FileName := GetConfigFileName;

  MemStream := TMemoryStream.Create;
  try
    actmgrMain.SaveToStream(MemStream);
    MemStream.Position := 0;
    FileStream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
    try
{$IFDEF DEBUG}
      ObjectBinaryToText(MemStream, FileStream);
{$ELSE}
      FileStream.WriteData(MemStream.Size);
      with TCompressionStream.Create(clMax, FileStream) do
      try
        CopyFrom(MemStream, 0);
      finally
        Free;
      end;
{$ENDIF}
    finally
      FileStream.Free;
    end;
  finally
    MemStream.Free;
  end;
end;

function TmodActions.NotifyFiltersToStr(const NotifyFilters: TNotifyFilters): string;
var
  nfe: TNotifyFilter;
begin
  Result := '';
  for nfe := Low(TNotifyFilter) to High(TNotifyFilter) do begin
    if nfe in NotifyFilters then begin
      if Result <> '' then
        Result := Result + ', ';
      Result := Result + GetEnumName(TypeInfo(TNotifyFilter), Ord(nfe));
    end;
  end;
end;

function TmodActions.StrToNotifyFilters(const NotifyFilters: string): TNotifyFilters;
var
  Name: string;
  Value: Integer;
  EnumType: PTypeInfo;
begin
  Result := [];
  EnumType := GetTypeData(TypeInfo(TNotifyFilters)).CompType^;
  for Name in NotifyFilters.Split([',']) do begin
    if string.IsNullOrWhiteSpace(Name) then Continue;

    Value := GetEnumValue(EnumType, Name.Trim);
    if Value = -1 then
      raise EConvertError.CreateFmt('Unknown enumeration member: "%s"', [Name]);
    Include(Result, TNotifyFilter(Value));
  end;
end;

procedure TmodActions.WatchersNotify(Sender: TObject; const Watcher: TFileSystemWatcher; Action: TCollectionNotification);
var
  Handler: TCollectionNotifyEvent<TFileSystemWatcher>;
begin
  // propagate the event
  for Handler in FHandlers do begin
    Handler(Self, Watcher, Action);
  end;
end;


end.

Added src/ShellUtils.pas.





















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
unit ShellUtils;

interface
uses
  Graphics;

function GetShellFileIcon(const FullPath: string; const Large, Open: Boolean): TIcon;
function GetShellFolderIcon(const Large, Open: Boolean): TIcon; overload;
function GetShellFolderIcon(const FullPath: string; const Large, Open: Boolean): TIcon; overload;

implementation
uses
  Winapi.Windows, Winapi.ShellAPI;

{$REGION 'GetShellIcon'}
function GetShellFileIcon(const FullPath: string; const Large, Open: Boolean): TIcon;
var
  FileInfo: TSHFileInfo;
  Flags: Integer;
begin
  Flags := SHGFI_ICON or SHGFI_USEFILEATTRIBUTES;
  if Open then Flags := Flags or SHGFI_OPENICON;
  if Large then Flags := Flags or SHGFI_LARGEICON
  else Flags := Flags or SHGFI_SMALLICON;
  SHGetFileInfo(PChar(FullPath),
                FILE_ATTRIBUTE_NORMAL,
                FileInfo,
                SizeOf(FileInfo),
                Flags);
  Result := TIcon.Create;
  Result.Handle := FileInfo.hIcon;
end;

function GetShellFolderIcon(const FullPath: string; const Large, Open: Boolean): TIcon;
var
  FileInfo: TSHFileInfo;
  Flags: Integer;
begin
  Flags := SHGFI_ICON or SHGFI_USEFILEATTRIBUTES;
  if Open then Flags := Flags or SHGFI_OPENICON;
  if Large then Flags := Flags or SHGFI_LARGEICON
  else Flags := Flags or SHGFI_SMALLICON;
  SHGetFileInfo(PChar(FullPath),
                FILE_ATTRIBUTE_DIRECTORY,
                FileInfo,
                SizeOf(FileInfo),
                Flags);
  Result := TIcon.Create;
  Result.Handle := FileInfo.hIcon;
end;

function GetShellFolderIcon(const Large, Open: Boolean): TIcon;
begin
  Result := GetShellFolderIcon('Folder', Large, Open);
end;
{$ENDREGION}

end.

Changes to src/prj/FolderWatcher.dpr.

1
2
3
4

5

6
7
8
9
10

11
12

13
14
15
program FolderWatcher;

uses
  Vcl.Forms,

  FMain in '..\FMain.pas' {frmFolderWatcher};


{$R *.res}

begin
  Application.Initialize;

  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmFolderWatcher, frmFolderWatcher);

  Application.Run;
end.




|
>
|
>





>


>



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
program FolderWatcher;

uses
  Forms,
  SysUtils,
  FMain in '..\FMain.pas' {frmFolderWatcher},
  M_Actions in '..\M_Actions.pas' {modActions: TDataModule};

{$R *.res}

begin
  Application.Initialize;
  Application.Name := ChangeFileExt(ExtractFileName(ParamStr(0)), '');
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmFolderWatcher, frmFolderWatcher);
  Application.CreateForm(TmodActions, modActions);
  Application.Run;
end.

Changes to src/prj/FolderWatcher.dproj.

42
43
44
45
46
47
48








49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
..
71
72
73
74
75
76
77




78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
...
101
102
103
104
105
106
107



108

109
110
111
112
113
114
115
...
126
127
128
129
130
131
132







133


134
135
136
137
138
139
140
141
142
143
144
    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
        <Cfg_2_Win32>true</Cfg_2_Win32>
        <CfgParent>Cfg_2</CfgParent>
        <Cfg_2>true</Cfg_2>
        <Base>true</Base>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">








        <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
        <SanitizedProjectName>FolderWatcher</SanitizedProjectName>
        <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
        <VerInfo_Locale>1043</VerInfo_Locale>
        <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
        <DCC_E>false</DCC_E>
        <DCC_N>false</DCC_N>
        <DCC_S>false</DCC_S>
        <DCC_F>false</DCC_F>
        <DCC_K>false</DCC_K>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Win32)'!=''">
................................................................................
        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Win64)'!=''">
        <DCC_UsePackage>DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;OmniThreadLibraryRuntime;UIRibbonPackageDR;SysToolsDBDR;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DL_Control;vclimg;SysToolsDR;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;Intraweb;FireDACSqliteDriver;FireDACPgDriver;wPDF3;inetdb;VirtualTreesDR;RaizeComponentsVcl;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;Tee;fmxobj;vclwinx;EasyListviewD;rtl;VirtualShellToolsD;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;SynEditDR;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;AbbreviaVCL;vclie;MPCommonLibD;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;PowerPDFDR;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1)'!=''">




        <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
        <DCC_DebugDCUs>true</DCC_DebugDCUs>
        <DCC_Optimize>false</DCC_Optimize>
        <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
        <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
        <DCC_RemoteDebug>true</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">

        <AppEnableHighDPI>true</AppEnableHighDPI>
        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
        <VerInfo_Locale>1033</VerInfo_Locale>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <DCC_RemoteDebug>false</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_2)'!=''">
................................................................................
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="..\FMain.pas">
            <Form>frmFolderWatcher</Form>



            <FormType>dfm</FormType>

        </DCCReference>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
................................................................................
            <Delphi.Personality>
                <Source>
                    <Source Name="MainSource">FolderWatcher.dpr</Source>
                </Source>
                <Excluded_Packages>
                    <Excluded_Packages Name="$(BDSBIN)\dcloffice2k240.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
                    <Excluded_Packages Name="$(BDSBIN)\dclofficexp240.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>







                    <Excluded_Packages Name="W:\Lib\BPL\RaizeComponentsVcl310.bpl">Raize Components VCL</Excluded_Packages>


                </Excluded_Packages>
            </Delphi.Personality>
            <Deployment Version="3">
                <DeployFile LocalName="Win32\Debug\FolderWatcher.exe" Configuration="Debug" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>FolderWatcher.exe</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
                <DeployClass Name="AdditionalDebugSymbols">
                    <Platform Name="Win32">







>
>
>
>
>
>
>
>



|



|
|







 







>
>
>
>

<






>







 







>
>
>

>







 







>
>
>
>
>
>
>
|
>
>



|







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
..
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
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
        <Cfg_2_Win32>true</Cfg_2_Win32>
        <CfgParent>Cfg_2</CfgParent>
        <Cfg_2>true</Cfg_2>
        <Base>true</Base>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">
        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
        <VerInfo_MajorVer>0</VerInfo_MajorVer>
        <DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
        <DCC_DebugInformation>0</DCC_DebugInformation>
        <DCC_UnitSearchPath>..;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
        <VerInfo_PreRelease>true</VerInfo_PreRelease>
        <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
        <SanitizedProjectName>FolderWatcher</SanitizedProjectName>
        <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=net.2of4.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
        <VerInfo_Locale>1043</VerInfo_Locale>
        <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
        <DCC_DcuOutput>..\..\out\dcu\$(Platform)\$(Config)</DCC_DcuOutput>
        <DCC_ExeOutput>..\..\out\$(Platform)\$(Config)</DCC_ExeOutput>
        <DCC_E>false</DCC_E>
        <DCC_N>false</DCC_N>
        <DCC_S>false</DCC_S>
        <DCC_F>false</DCC_F>
        <DCC_K>false</DCC_K>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Win32)'!=''">
................................................................................
        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Win64)'!=''">
        <DCC_UsePackage>DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;OmniThreadLibraryRuntime;UIRibbonPackageDR;SysToolsDBDR;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DL_Control;vclimg;SysToolsDR;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;Intraweb;FireDACSqliteDriver;FireDACPgDriver;wPDF3;inetdb;VirtualTreesDR;RaizeComponentsVcl;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;Tee;fmxobj;vclwinx;EasyListviewD;rtl;VirtualShellToolsD;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;SynEditDR;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;AbbreviaVCL;vclie;MPCommonLibD;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;PowerPDFDR;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1)'!=''">
        <DCC_DebugInformation>2</DCC_DebugInformation>
        <DCC_RangeChecking>true</DCC_RangeChecking>
        <DCC_SymbolReferenceInfo>2</DCC_SymbolReferenceInfo>
        <DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck>
        <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>

        <DCC_Optimize>false</DCC_Optimize>
        <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
        <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
        <DCC_RemoteDebug>true</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
        <Icon_MainIcon>FolderWatcher_Icon.ico</Icon_MainIcon>
        <AppEnableHighDPI>true</AppEnableHighDPI>
        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
        <VerInfo_Locale>1033</VerInfo_Locale>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <DCC_RemoteDebug>false</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_2)'!=''">
................................................................................
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="..\FMain.pas">
            <Form>frmFolderWatcher</Form>
        </DCCReference>
        <DCCReference Include="..\M_Actions.pas">
            <Form>modActions</Form>
            <FormType>dfm</FormType>
            <DesignClass>TDataModule</DesignClass>
        </DCCReference>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
................................................................................
            <Delphi.Personality>
                <Source>
                    <Source Name="MainSource">FolderWatcher.dpr</Source>
                </Source>
                <Excluded_Packages>
                    <Excluded_Packages Name="$(BDSBIN)\dcloffice2k240.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
                    <Excluded_Packages Name="$(BDSBIN)\dclofficexp240.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\AbbreviaVCLDesign310.bpl">File W:\LIB\BPL\AbbreviaVCLDesign310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\DL_Control310.bpl">File W:\LIB\BPL\DL_Control310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\RaizeComponentsVcl_Design310.bpl">File W:\LIB\BPL\RaizeComponentsVcl_Design310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\sdlbasepack310.bpl">File W:\LIB\BPL\sdlbasepack310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\sdlmathpack310.bpl">File W:\LIB\BPL\sdlmathpack310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\tmsded310.bpl">File W:\LIB\BPL\tmsded310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\LIB\BPL\wPDF3310.bpl">File W:\LIB\BPL\wPDF3310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\Lib\BPL\RaizeComponentsVcl310.bpl">File W:\Lib\BPL\RaizeComponentsVcl310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\Lib\BPL\tmsd310.bpl">File W:\Lib\BPL\tmsd310.bpl not found</Excluded_Packages>
                    <Excluded_Packages Name="W:\Lib\BPL\tmsexd310.bpl">File W:\Lib\BPL\tmsexd310.bpl not found</Excluded_Packages>
                </Excluded_Packages>
            </Delphi.Personality>
            <Deployment Version="3">
                <DeployFile LocalName="..\..\out\Win32\Debug\FolderWatcher.exe" Configuration="Debug" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>FolderWatcher.exe</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
                <DeployClass Name="AdditionalDebugSymbols">
                    <Platform Name="Win32">