-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathFixer.clw
585 lines (530 loc) · 30.3 KB
/
Fixer.clw
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
PROGRAM
! Fixer 1.0 Begun 30 July 2019
! First posted to GitHub 16 Sept 2019 https://github.com/DonnEdwards/Fixer
! Written by Donn Edwards (c) 2019 WatchManager.Net donn (at) watchmanager.net
! with much help from the ClarionLive and ClarionHub community.
! Also from the Clarion SHOWIMG example at SoftVelocity\Clarion10\Examples\SRC\SHOWIMG
! And the CapeSoft String Theory library
! And Mark Goldberg for the Debuger library https://github.com/MarkGoldberg/ClarionCommunity
! and his generous code review
! I used the debug viewer found here: https://github.com/CobaltFusion/DebugViewPP
! Thanks to Graham Smith of WatchManager.Net for his time and attention, and library code
!
!Region Principled programming
! ---------------------------------------------------------------------------
! From www.developerdotstar.com:
!
! Principled Programming:
! =======================
!
! Personal Character
! ------------------
! Write your code so that it reflects, or rises above, the best parts of your
! personal character.
!
! Aesthetics
! ----------
! Strive for beauty and elegance in every aspect of your work.
!
! Clarity
! -------
! Value clarity equally with correctness. Utilize the proven techniques that
! will produce clarity in your code. Correctness will likely follow suit.
!
! Layout
! ------
! Use the visual layout of your code to communicate the structure of your code
! to human readers.
!
! Explicitness
! ------------
! Always favour the explicit over the implicit.
!
! Self-Documenting Code
! ---------------------
! The most reliable document of software is the code itself. In many cases,
! the code is the *only* documentation. Therefore, strive to make your code
! self-documenting, and where you can't, add comments.
!
! Comments
! --------
! Comment in full sentences in order to summarize and communicate intent.
!
! Assumptions
! -----------
! Take reasonable steps to test, document, and otherwise draw attention to the
! assumptions made in every module and routine.
!
! User Interaction
! ----------------
! Never make the user feel stupid.
!
! Going Back
! ----------
! The time to write good code is at the time you are writing it.
!
! Other People's Time and Money
! -----------------------------
! A true professional does not waste the time and money of other people by
! handing over software that is not reasonably free of obvious bugs; that has
! not undergone minimal unit testing; that does not meet the specifications and
! requirements; that is gold-plated with unnecessary features; or that looks
! like junk.
!
! Written by Daniel Read dan (at) developerdotstar.com
! Full version at http://www.developerdotstar.com/mag/articles/read_princprog.html
!
! -----------------------------------------------------------------------------
!EndRegion Principled programming
INCLUDE('equates.clw'),ONCE
INCLUDE('StringTheory.Inc'),ONCE ! String Theory (c) CapeSoft
INCLUDE('debuger.inc'),ONCE ! \Examples\ClarionCommunity-master\CW\Shared\Src
DBG Debuger ! https://github.com/MarkGoldberg/ClarionCommunity
clsNameQ QUEUE,TYPE ! Queue structure for file names
qFullFileName CSTRING(FILE:MaxFilePath) ! Full file name including path
qShortFileName CSTRING(FILE:MaxFileName) ! File name without the path
END
clsSearchReplaceQ QUEUE,TYPE ! Queue structure for search and replace
qSearchString CSTRING(1024) ! Search for this string
qReplaceString CSTRING(1024) ! Replace it with this string
qPairNo SHORT ! Pair Number
END
strSearchString CSTRING(255) ! Search for this string
strReplaceString CSTRING(255) ! Replace it with this string
intPairNo SHORT ! Displayed Pair number
qqFileNames clsNameQ ! Queue containing list of files to be processed
strBrowseBase CSTRING(FILE:MaxFilePath) ! Project folder
strIniFileName CSTRING(FILE:MaxFilePath) ! Location of Fixer.ini
strBrowseExtensions CSTRING(255) ! List of File extensions to be processed
strExcludeSubFolders CSTRING(255) ! List of folders to be ignored
qqSearchReplace clsSearchReplaceQ ! Queue containing search and replace strings
!===============================================================================================================
MAP
INCLUDE('cwutil.inc'),ONCE
UpdateVaues ! Update the edited values on the form, save them to the INI file
GetListBoxValues ! When the user click on an entry in the listbox, update the editing controls
ProcessAllFiles ! The bulk of the file processing happens here
OpenConfigFile ! Display Fixer.ini in the default INI text editor
ReadConfigFile ! Read the contents of fixer.ini
SaveConfigFile ! Save values to Fixer.ini
GetAllFiles (STRING pDir, *clsNameQ pDirQ) ! Procedure to find all the matching files to be processed
ProcessThisFile (STRING pFullFileName, STRING pShortFileName) ! Read the file, make a backup, make changes, save
ExtractFileExtension (STRING pFileName) STRING ! Get the filename extension
Fix_Path (STRING pPath) STRING ! Check Path for trailing \
MODULE('')
! SLEEP(LONG),PASCAL ! Declare Sleep command
OutputDebugString (CONST *CSTRING),PASCAL,NAME('OutputDebugStringA') ! Debuger
errno(),*SIGNED,NAME('__errno__') !prototype built-in error flag, used by CreateDirectory
END
ODS (STRING Msg) ! Clarionized OutputDebugString
END
!---------------------------------------------------------------------------------------------------------------
MyWindow WINDOW('Fixer 1.0'),AT(,,270,196),FONT('Tahoma',9,,FONT:regular),RESIZE,CENTER,GRAY,|
ICON('WIZFIND.ICO'),SYSTEM,STATUS
! Go button is the default button for the program
BUTTON('&Go'),AT(100,170,36,14),USE(?GoButton),DEFAULT,RIGHT,TIP('Scan and process the files')
! Title and explanation of what the program does
PROMPT('Scan and replace text in Clarion text files'),AT(10,10,250),CENTER,FONT(,12,,FONT:regular)
! Button to open the currently selected project folder
BUTTON('Open the project folder'),AT(10,30,250,14),USE(?OpenFolder),FLAT,TIP('Open the project folder')
! List box with the search/replace queue
LIST,AT(17,50,240,60),VSCROLL,FROM(qqSearchReplace),IMM,MSG('Search and Replace data'),|
FORMAT('100L(2)|M~Search~C(2)@s40@102L(2)|M~Replace~C(2)@s38@40L(2)|M~No~L(2)'),|
USE(?ListBox)
! Edit box for search/replace pairs and sequence number
ENTRY(@S255),AT(17,115,99,10), USE(strSearchString),MSG('Use this to edit the search string')
ENTRY(@S255),AT(119,115,98,10),USE(strReplaceString),MSG('Use this to edit the replace string')
ENTRY(@N4),AT(221,115,36,10), USE(intPairNo),MSG('Use this to edit a particular entry')
! Update button to make the edit happen
BUTTON('Update'),AT(221,127,36,14),USE(?UpdateButton),DEFAULT,LEFT,MSG('Update the Search and Replace Data'),|
TIP('Click to update the Search and Replace pair')
! Button to inspect the INI config file
BUTTON('View &Config'),AT(140,150,66,14),USE(?EditButton),DEFAULT,LEFT,MSG('View the config file'),|
TIP('Click to open the config file for viewing')
! Button to get a dialog box to choose the project folder
BUTTON('Project &Folder'),AT(70,150,66,14),USE(?FolderButton),DEFAULT,RIGHT,MSG('Select the folder'),|
TIP('Select the project folder and store it in the config file')
! Exit the program
BUTTON('E&xit'),AT(140,170,36,14),USE(?CloseButton),LEFT,MSG('Close the program'),|
TIP('Close the program'),STD(STD:Close)
END
!---------------------------------------------------------------------------------------------------------------
CODE
DBG.mg_init('Fixer') ! Get the Debuger started
DBG.ClearLog()
ReadConfigFile ! Get all the INI settings
OPEN(MyWindow)
?OpenFolder{PROP:Text} = strBrowseBase ! set the button text to the project folder setting
! ?PairNo{PROP:Use} = intPairNo
!DBG.PrintEvent('No=' & intPairNo)
! ?SearchString{PROP:Use} = strSearchString
!DBG.PrintEvent('Search=' & strSearchString)
! ?ReplaceString{PROP:Use} = strReplaceString
!DBG.PrintEvent('Replace=' & strReplaceString)
MyWindow{PROP:StatusText} = 'Fixer 1.0.5 (c) 2019 Watchmanager.net' ! <--- Program version
ACCEPT
CASE ACCEPTED()
OF ?UpdateButton ; UpdateVaues ! Update the edited values
OF ?ListBox ; GetListBoxValues ! Get the clicked value of the list box
OF ?FolderButton ; DO AskFolderRoutine ! Ask for the correct folder
OF ?EditButton ; OpenConfigFile() ! Allow the user to inspect Fixer.ini
OF ?OpenFolder ; RUN('explorer.exe "' & strBrowseBase & '"',1) ! Show the folder
OF ?GoButton ; ProcessAllFiles() ! The bulk of the work happens here
OF ?CloseButton ; POST(EVENT:CloseWindow) ! All done
END
END
RETURN
!---------------------------------------------------------------------------------------------------------------
AskFolderRoutine ROUTINE
!// When the user clicks on the project folder button, get the project path
FILEDIALOG('Choose Project Folder',strBrowseBase,,FILE:Directory+FILE:LongName+FILE:KeepDir)
IF ~strBrowseBase ! Default if nothing selected
strBrowseBase = PATH() & '\'
END
strBrowseBase = CLIP(Fix_Path(strBrowseBase)) ! Fix the path selected to have a trailing \
SaveConfigFile() ! Remember it
?OpenFolder{PROP:Text} = strBrowseBase ! Update the button text with the new folder
!===============================================================================================================
UpdateVaues PROCEDURE
!// Update the edited values on the form, save them to the INI file
CODE
!DBG.PrintEvent(RECORDS(qqSearchReplace))
!DBG.PrintEvent('No=' & ?No)
! intPairNo = ?PairNo{PROP:Value} ! Which entry are we working with?
IF intPairNo < 1 ! Invalid entry number or empty queue
intPairNo = 1
END
DBG.PrintEvent('PairNo=' & intPairNo)
! strSearchString = ?SearchString{PROP:Value}
DBG.PrintEvent('Find=' & strSearchString)
! strReplaceString = ?ReplaceString{PROP:Value}
DBG.PrintEvent('Repl=' & strReplaceString)
IF intPairNo > RECORDS(qqSearchReplace) ! Invalid entry number
intPairNo = RECORDS(qqSearchReplace) + 1 ! Add a new entry
! ?PairNo{PROP:Use} = intPairNo ! Correct the display
END
IF intPairNo > RECORDS(qqSearchReplace) ! Add a new entry
IF LEN(CLIP(strSearchString)) > 0 ! Ignore blank searches
CLEAR(qqSearchReplace) ! Clear the queue entry
qqSearchReplace.qSearchString = strSearchString
qqSearchReplace.qReplaceString = strReplaceString
qqSearchReplace.qPairNo = intPairNo
ADD(qqSearchReplace) ! Add the pair to the queue
!DBG.PrintEvent('ADD ' & RECORDS(qqSearchReplace))
END
ELSE
CLEAR(qqSearchReplace) ! Clear the queue entry
GET(qqSearchReplace,intPairNo) ! get the entry to be updated
qqSearchReplace.qSearchString = strSearchString
qqSearchReplace.qReplaceString = strReplaceString
qqSearchReplace.qPairNo = intPairNo
PUT(qqSearchReplace) ! Update the queue
!DBG.PrintEvent('PUT ' & intPairNo)
END
SaveConfigFile() ! Store the queue in the INI file
!
ReadConfigFile() ! Update the display with current values
! ?PairNo{PROP:Use} = intPairNo
! !DBG.PrintEvent('No=' & intPairNo)
! ?SearchString{PROP:Use} = strSearchString
! !DBG.PrintEvent('Search=' & strSearchString)
! ?ReplaceString{PROP:Use} = strReplaceString
?ListBox{PROP:Use} = qqSearchReplace ! Update the listbox
?ListBox{PROP:Selected} = intPairNo ! Highlight the correct entry
RETURN
!---------------------------------------------------------------------------------------------------------------
GetListBoxValues PROCEDURE
!// When the user click on an entry in the listbox, update the editing controls
i LONG
CODE
i = ?ListBox{PROP:Selected} ! Get highlighted entry from queue
GET(qqSearchReplace,i) ! Get the data from the queue
strSearchString = qqSearchReplace.qSearchString ! Save it locally
strReplacestring = qqSearchReplace.qReplaceString
intPairNo = qqSearchReplace.qPairNo
DISPLAY(strSearchString) ! Update the editing controls
! ?strSearchString{PROP:Use} = strSearchString
DISPLAY(strReplaceString)
! ?strReplaceString{PROP:Use} = strReplaceString
DISPLAY(intPairNo)
! ?intPairNo{PROP:Use} = intPairNo
! DBG.PrintEvent('No_=' & intPairNo)
! DBG.PrintEvent('Search_=' & strSearchString)
! DBG.PrintEvent('Replace_=' & strReplaceString)
RETURN
!---------------------------------------------------------------------------------------------------------------
ProcessAllFiles PROCEDURE
!// The bulk of the file processing happens here
loc:fullfilename CSTRING(FILE:MaxFilePath)
loc:shortfilename CSTRING(64)
i LONG,AUTO
n LONG,AUTO
CODE
MyWindow{PROP:StatusText} = 'Processing the folders ...'
FREE(qqFileNames)
CLEAR(qqFileNames) ! Clear the queue
!
GetAllFiles(strBrowseBase,qqFileNames) ! Load the file names into qqFileNames
n = 0
MyWindow{PROP:StatusText} = 'Processing each file ...'
LOOP i = 1 to RECORDS(qqFileNames)
GET(qqFileNames,i) ! Get the file name from the queue
IF ERRORCODE()
STOP(ERROR())
END
loc:fullfilename = qqFileNames.qFullFileName ! Save the file name locally
loc:shortfilename = qqFileNames.qShortFileName
MyWindow{PROP:StatusText} = (n+1) & ' ' & loc:shortfilename ! Display it
DISPLAY
! SLEEP(1000)
!DBG.PrintEvent (loc:fullfilename)
ProcessThisFile(loc:fullfilename,loc:shortfilename)
n += 1
END ! LOOP i
FREE(qqFileNames) ! Get rid of the entire queue
CLEAR(qqFileNames) ! Clear the buffers
MyWindow{PROP:StatusText} = n & ' files processed'
SaveConfigFile
!RUN('explorer.exe "' & strBrowseBase & '"',1) ! Show the folder
RETURN
!---------------------------------------------------------------------------------------------------------------
ProcessThisFile PROCEDURE(STRING pFullFileName, STRING pShortFileName)
!// Read the file, make a backup, make changes, save
! Source file example: c:\dev\myfile.clw
! Target file example: c:\dev\.txt\myfile.clw.txt
st StringTheory
i LONG,AUTO
loc:sourcefilename CSTRING(FILE:MaxFilePath)
loc:targetfilename CSTRING(FILE:MaxFilePath)
loc:targetfolder CSTRING(FILE:MaxFilePath)
CODE
loc:sourcefilename = CLIP(pFullFileName)
! DBG.PrintEvent(loc:sourcefilename)
i = LEN(CLIP(pShortFileName))
loc:targetfolder = SUB(loc:sourcefilename,1,LEN(loc:sourcefilename)-i) & '.txt\'
! DBG.PrintEvent(loc:targetfolder)
loc:targetfilename = loc:targetfolder & CLIP(pShortFileName) & '.txt'
! DBG.PrintEvent(loc:targetfilename)
IF NOT EXISTS(loc:targetfolder) ! Check for target folder
IF CreateDirectory(loc:targetfolder) ! Create Target folder
CASE Errno()
OF 3
MESSAGE('Path Not Found')
OF 5
MESSAGE('Access Denied')
OF 183
MESSAGE('Directory Already Exists')
ELSE
MESSAGE('Unknown Error ' & Errno())
END
END
END
IF EXISTS(loc:targetfilename) ! Target file
REMOVE(loc:targetfilename)
IF ERRORCODE()
STOP(ERROR())
END
END
IF EXISTS(loc:sourcefilename) ! Original file
COPY(loc:sourcefilename,loc:targetfilename) ! Make a copy of the file
IF ERRORCODE()
STOP(ERROR())
END
st.LoadFile(loc:targetfilename) ! Read the entire copied file
IF ERRORCODE()
STOP(ERROR())
END
!// Make the changes to the target file here
LOOP i = 1 to RECORDS(qqSearchReplace)
GET(qqSearchReplace,i) ! Get the data from the queue
IF ERRORCODE()
STOP(ERROR())
END
! loc:searchstring = qqSearchReplace.qSearchString ! Save it locally
! loc:replacestring = qqSearchReplace.qReplaceString
IF LEN(CLIP(qqSearchReplace.qSearchString)) > 0 ! Only valid searches
st.Replace(qqSearchReplace.qSearchString,qqSearchReplace.qReplaceString) ! Do the search and replace across the entire file
END
END ! LOOP i
st.SaveFile(loc:targetfilename) ! Write the changed file back to disk
IF ERRORCODE()
STOP(ERROR())
END
END ! Original File
RETURN
!---------------------------------------------------------------------------------------------------------------
OpenConfigFile PROCEDURE
!// Open the config file for editing or viewing in notepad or whatever
CODE
RUN(strIniFileName) ! Open Fixer.ini in notepad or text editor
RETURN
!---------------------------------------------------------------------------------------------------------------
ReadConfigFile PROCEDURE
!// Read the contents of the config file into their respective variables and queue
loc:findcount SHORT,AUTO
i SHORT,AUTO
CODE
FREE(qqSearchReplace)
CLEAR(qqSearchReplace) ! Clear the queue
strIniFileName = PATH() & '\Fixer.ini' ! The location of Fixer.ini
IF FileExists(strIniFileName)
loc:findcount = (CLIP(GETINI('FixerSR','FindCount',0, strIniFileName)))
loc:findcount += 1 ! Check for one more pair
intPairNo = 0
LOOP i = 1 TO loc:findcount ! Go through the declared pairs
strSearchString = GETINI('FixerSR','Find_' & CLIP(i),'', strIniFileName)
strReplaceString = GETINI('FixerSR','Repl_' & CLIP(i),'', strIniFileName)
IF LEN(CLIP(strSearchString)) > 0 ! Ignore blank searches
intPairNo += 1 ! increment intPairNo
qqSearchReplace.qSearchString = strSearchString
qqSearchReplace.qReplaceString = strReplaceString
qqSearchReplace.qPairNo = intPairNo
ADD(qqSearchReplace) ! Add the pair to the queue
END
END ! LOOP i
ELSE ! Fixer.ini is missing, so create a default one
qqSearchReplace.qSearchString = 'MS Sans Serif'
qqSearchReplace.qReplaceString = 'Tahoma'
qqSearchReplace.qPairNo = 1
ADD(qqSearchReplace) ! Add a default pair to the queue
qqSearchReplace.qSearchString = 'Microsoft Sans Serif'
qqSearchReplace.qReplaceString = 'Tahoma'
qqSearchReplace.qPairNo = 2
ADD(qqSearchReplace) ! Add another default pair to the queue
END
strBrowseBase = GETINI('Fixer', 'Project', PATH() & '\', strIniFileName) ! The folder Fixer will work in
strBrowseExtensions = GETINI('Fixer', 'Extensions','.clw|.inc', strIniFileName) ! List of file extensions
strExcludeSubFolders = GETINI('Fixer', 'ExcludeSubFolders','.txt|.git|map|obj', strIniFileName) ! Ignore these subfolders
strSearchString = qqSearchReplace.qSearchString ! Remember the last value
strReplaceString = qqSearchReplace.qReplaceString
intPairNo = RECORDS(qqSearchReplace)
!DBG.PrintEvent('No_=' & intPairNo)
!DBG.PrintEvent('Search_=' & strSearchString)
!DBG.PrintEvent('Replace_=' & strReplaceString)
RETURN
!---------------------------------------------------------------------------------------------------------------
SaveConfigFile PROCEDURE
!// Save the config file variables back to the file
i LONG,AUTO
n LONG,AUTO
loc:searchstring CSTRING(255)
loc:replacestring CSTRING(255)
CODE
PUTINI('Fixer', , , strIniFileName) ! delete the entire section
PUTINI('Fixer', 'Extensions', strBrowseExtensions, strIniFileName) ! write the section values
PUTINI('Fixer', 'ExcludeSubFolders', strExcludeSubFolders, strIniFileName)
PUTINI('Fixer', 'Project', strBrowseBase, strIniFileName)
PUTINI('FixerSR', , , strIniFileName) ! delete the entire section
n = 0
PUTINI('FixerSR', 'FindCount', RECORDS(qqSearchReplace), strIniFileName)
LOOP i = 1 to RECORDS(qqSearchReplace)
GET(qqSearchReplace,i) ! Get the data from the queue
IF ERRORCODE()
STOP(ERROR())
END
loc:searchstring = qqSearchReplace.qSearchString ! Save it locally
loc:replacestring = qqSearchReplace.qReplaceString
IF LEN(CLIP(loc:searchstring)) > 0 ! Only valid searches
n += 1 ! increment n
PUTINI('FixerSR', 'Find_' & CLIP(n), loc:searchstring, strIniFileName)
!DBG.PrintEvent('Find_' & CLIP(n) & ' ' & loc:searchstring)
PUTINI('FixerSR', 'Repl_' & CLIP(n), loc:replacestring, strIniFileName)
!DBG.PrintEvent('Repl_' & CLIP(n) & ' ' & loc:replacestring)
END ! LEN
END ! LOOP i
IF n <> RECORDS(qqSearchReplace) ! One or more invalid searches
PUTINI('FixerSR', 'FindCount', n, strIniFileName) ! Update FindCount
END ! n
RETURN
!---------------------------------------------------------------------------------------------------------------
GetAllFiles PROCEDURE(STRING pDir, clsNameQ pDirQ)
!// Procedure to find all the matching files to be processed
! Heavily borrowed from C:\Users\Public\Documents\SoftVelocity\Clarion10\Examples\SRC\SHOWIMG
!
ffq QUEUE ! Required structure for DIRECTORY function
Name STRING(FILE:MaxFileName)
fName STRING(13)
Date LONG
Time LONG
Size LONG
Attrib BYTE
END
loc:filename CSTRING(FILE:MaxFileName)
loc:extension CSTRING(FILE:MaxFileName)
loc:folder CSTRING(FILE:MaxFileName)
i LONG,AUTO
CODE
loc:filename = CLIP(pDir)
MyWindow{PROP:StatusText} = loc:filename
! DBG.PrintEvent(loc:filename)
DISPLAY
DIRECTORY(ffq, CLIP(pDir) & '*.*', ff_:NORMAL) ! Load the directory into ffq
LOOP i = 1 to RECORDS(ffq)
GET(ffq, i)
loc:filename = CLIP(ffq.Name)
loc:extension = CLIP(ExtractFileExtension(loc:filename)) ! get the extension
IF MATCH(loc:extension, strBrowseExtensions, Match:Regular+Match:NoCase)! Find matching file extension
pDirQ:qFullFileName = CLIP(pDir) & loc:filename
pDirQ:qShortFileName = loc:filename
ADD(pDirQ) ! Add the filename to my queue
MyWindow{PROP:StatusText} = CLIP(pDir) & loc:filename ! Show the full file name
! DBG.PrintEvent(loc:filename)
END
END
FREE(ffq)
DIRECTORY(ffq, CLIP(pDir) & '*.*', ff_:DIRECTORY) ! Recurse to subfolders
LOOP i = 1 to RECORDS(ffq)
GET(ffq, i)
loc:folder = CLIP(ffq.Name)
! DBG.PrintEvent(loc:folder)
IF BAND(ffq.Attrib,ff_:DIRECTORY) AND loc:folder <> '..' AND loc:folder <> '.' THEN
IF NOT MATCH(loc:folder, strExcludeSubFolders, Match:Regular+Match:NoCase)! Find matching folder name
GetAllFiles(CLIP(pDir) & loc:folder & '\', pDirQ) ! Add files from subfolders
! DBG.PrintEvent(loc:folder)
END
END
END
!---------------------------------------------------------------------------------------------------------------
Fix_Path FUNCTION (STRING pPath)
!// Check path for trailing \ and add it if necessary
! Written by Graham Smith as part of gsTools (c) WatchManager.net
loc:path CSTRING(FILE:MaxFilePath)
CODE ! Begin processed code
loc:path = CLIP(pPath)
!
IF loc:Path <> '' THEN ! Is it a valid path
if SUB(loc:Path, LEN(loc:Path), 1) <> '\' THEN ! Trailing \?
loc:Path = loc:Path & '\' ! Add the trailing \
end
END
!
RETURN loc:Path ! Return the result
!---------------------------------------------------------------------------------------------------------------
ExtractFileExtension FUNCTION (STRING pPathFileName)
!// Get the FileName extension, including the dot
!
loc:filename CSTRING(FILE:MaxFilePath)
loc:extension CSTRING(FILE:MaxFileName)
n SHORT,AUTO
CODE ! Begin processed code
loc:filename = '\' & pPathFileName
n = INSTRING('\',loc:filename,-1,LEN(loc:filename)) ! find the \ in the file path
loc:filename = SUB(loc:filename,n+1,LEN(loc:filename)) ! exclude the path
n = INSTRING('.',loc:filename,-1,LEN(loc:filename)) ! find the dot in the filename (not in the path)
IF n > 0
loc:extension = SUB(loc:filename,n,LEN(CLIP(loc:filename))-n+1) ! get the extension
ELSE
loc:extension = ''
END
!
RETURN loc:extension ! Return the result
!---------------------------------------------------------------------------------------------------------------
! Part of the Debuger code
! https://github.com/MarkGoldberg/ClarionCommunity
ODS PROCEDURE(STRING Msg) !Clarionized OutputDebugString, the ` is to aid Filtering in DbgView
szMsg CSTRING(SIZE(Msg) + 4) ! 4 = 1 (for '`') + 2 (for '<13,10>) + 1 (for <0> terminator)
CODE
szMsg = '`' & MSG & '<13,10>' !and an implied <0>
OutputDebugString(szMsg)
RETURN
!---------------------------------------------------------------------------------------------------------------