-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathAnnotatedBackups.bas
1344 lines (1004 loc) · 69.8 KB
/
AnnotatedBackups.bas
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Option Explicit 'BASIC ###### AnnotatedBackups ######
'Editor=Wide load 4: Set your wide load editor to 4 column tabs, fixed size font. Suggest Kate (Linux) or Notepad++ (windows).
Const sProgramsVersion = "1.5.22" 'AnnotatedBackups current version
Const sSettingsVersion = "1" 'AnnotatedBackupsSettings minimum required version
' === Global constants used for MsgBox() ==========================================================
'Buttons displayed
Const sbOkOnly = 0
Const sbOkCancel = 1
Const sbAbortRetryIgnore = 2
Const sbYesNoCancel = 3
Const sbYesNo = 4
Const sbRetryCancel = 5
'Icons displayed
Const sbStop = 16
Const sbQuestion = 32
Const sbExclamation = 48
'Default button
Const sbDefaultButton1 =128 'first button is default
Const sbDefaultButton2 =256 '2nd button is default
Const sbDefaultButton3 =512 '3nd button is default
'Answers returned
Const sbOK = 1
Const sbCancel = 2
Const sbAbort = 3
Const sbRetry = 4
Const sbIgnore = 5
Const sbYes = 6
Const sbNo = 7
' === Global constants used for File operations ===================================================
Const NormalFiles = 0
Const SubDirsDirs = 16
' === MAIN PROGRAM - CALLED FROM MENU BUTTON ======================================================
Sub AnnotatedBackups() 'was: Sub AnnotatedBackups(Optional oDoc As Object)
' --- NAME AND PURPOSE -----------------------------------------------------------------------------------------------------
'
' AnnotatedBackups - On-demand Save and Backup for LibreOffice.
' First check for settings, and install or upgrade if necessary,
' Check a few other things. Also close any Forms or Reports.
' Do one or more backups of the current or given file, possibly removing older backups when done.
' --- DOCUMENTATION INCLUDING SETUP INSTRUCTIONS ---------------------------------------------------------------------------
'
' https://github.com/TopView/AnnotatedBackups
' --- CREDITS --------------------------------------------------------------------------------------------------------------
'
' Based partially on 'AutomaticBackup' by squenson, later extended by Ratslinger:
'
' squenson: https://forum.openoffice.org/en/forum/memberlist.php?mode=viewprofile&u=2781&sid=78e2eae7c08fba145326798ec04077b8
' [Basic] Save a document and create a timestamped copy: https://forum.openoffice.org/en/forum/viewtopic.php?f=21&t=23531
'
' ratslinger: https://ask.libreoffice.org/en/question/88856/suggeston-for-location-of-backup-files/?answer=89030#post-id-89030
' see also: https://ask.libreoffice.org/en/question/75460/libo-515-on-debian-85-writer-close-without-asking-to-save-in-need-of-an-automatic-incremental-saving-function/
' --- LICENSE - Creative Commons - Attribution-ShareAlike / CC BY-SA -------------------------------------------------------
' The previous work that this is based on was not oficially licensed, but still freely offered for use and further development. Because I was asked
' to select a license when uploading this to LibreOffice Wiki, I chose this which seems in keeping with the intent of the the other authors.
'
' This license lets others remix, tweak, and build upon your work even for commercial purposes, as long as they credit you and license
' their new creations under the identical terms. This license is often compared to “copyleft” free and open source software licenses.
' All new works based on yours will carry the same license, so any derivatives will also allow commercial use. This is the license used by
' Wikipedia, and is recommended for materials that would benefit from incorporating content from Wikipedia and similarly licensed projects.
' USE AT YOUR OWN RISK. No claims or warranties implied or otherwise as to its’ performance or accuracy.
' Please send updates, corrections, or suggestions to: EasyTrieve <[email protected]>
'=== Useful Constants =================================================================================
'-Base library names:
Const sLibraryName = "Standard" 'Name of settings Library
Const sProgramsName = "AnnotatedBackups" 'Name of programs Module
Const sSettingsName = "AnnotatedBackupsSettings" 'Name of settings Module (prefix)
'-End of line characters, (can't make these Const), :-( tip: these don't get passed to subs
Dim CR As String : CR = chr(10)
Dim C2 As String : C2 = chr(10)&chr(10)
' === First get or create settings and if old possibly update =========================================
'-Search my modules for the highest possible settings file version#
' Settings module names over time:
' AnnotatedBackupsSettings version 1 (orignial)
' AnnotatedBackupsSettingsV# versions 2,3,4...
' mri BasicLibraries :stop 'Get BOTH LibreOffice Macros & Dialogs AND My Macros & Dialogs
' mri DialogLibraries :stop '(not useful here)
' mri BasicLibraries.GetByName(sLibraryName) :stop 'Get Standard libraries
' mri ThisComponent.BasicLibraries :stop 'Get only this document's libs
Dim iVersion As Integer :iVersion = 0 'Default if no version found
Dim sElement As String
Dim oLib As Object :oLib = BasicLibraries.getByName(sLibraryName)
For Each sElement In oLib.ElementNames
if left(sElement,len(sSettingsName) ) = sSettingsName Then 'Some settings found..
If len(sElement) = len(sSettingsName) Then
' 'Copy older named AnnotatedBackupsSettings to newer name AnnotatedBackupsSettingsV1
' oLib.insertByName(sSettingsName & "V1", oLib.getByName(sSettingsName))
' oLib.removeByName(sSettingsName) 'works, but crashes, so took out 'Remove older settings (danger)
iVersion = Max(iVersion,1) 'Older style version 1 found
ElseIf left(sElement,len(sSettingsName)+1 ) = sSettingsName & "V" Then
iVersion = Max(iVersion,Right(sElement, len(sElement)-(len(sSettingsName)+1) )) 'Newer style version 2,3,4,etc. found
End If
End If
Next sElement
' MsgBox "Latest version found: " & iVersion :stop
'-Check sSettingsVersion sanity
If sSettingsVersion < iVersion Then MsgBox(_
"sSettingsVersion(=" & sSettingsVersion & ") should not be less than discovered iVersion(=" & iVersion & ")" & C2 _
&"(If you wanted to undo a version then you must also delete the version library.)" _
,sbOkOnly+sbExclamation _
,"FATAL CONFIGURATION ERROR"):stop
'-Make newer settings version if older version found
If iVersion < sSettingsVersion Then 'No settings found - must create settings
CreateSettingsModule(oLib, sProgramsName, SettingsName(sSettingsName,sSettingsVersion), sProgramsVersion)
'for test:
'iVersion = 0
'sSettingsVersion = 2
If MsgBox( iif(iVersion=0, "A ", "An updated") & " settings module was just created for you."_
&C2 _
_
_
& iif(iVersion=0, "", "Tip: Your previous setting are still found here:"_
&C2 _
& " My Macros & Dialogs | " & sLibraryName &" | "& SettingsName(sSettingsName,iVersion)_
&C2 _
)_
_
_
& iif(iVersion=0, "Default settings should probably be fine for now.",_
"Although default settings will work, you might want to first edit "&_
"your settings before proceeding with the backup, possibly migrating "&_
"your previous custom settings.")_
&C2 _
_
_
& iif(iVersion=0, "", "Your new setting are found here:"_
&C2 _
& " My Macros & Dialogs | " & sLibraryName & " | " & SettingsName(sSettingsName,sSettingsVersion)_
&C2 _
)_
_
& "Click OK to continue with your backup, or"_
&CR & "CANCEL to abort this backup, so you can first edit "_
& iif(iVersion=0, "", "or migrate ") & "your settings."_
_
,sbOkCancel+sbQuestion+sbDefaultButton1 _
,iif(iVersion=0, "A ", "A NEWER ") & " SETTINGS MODULE WAS JUST INSTALLED"_
) = sbCancel _
Then stop 'setup: 1=Ok/Cancel + 32=question mark + 128=first button is default results: 2=Cancel
End If
'-Get settings
' sSettingsName = sSettingsName & "V" & iVersion
Dim sPath As String 'Relative path from documents to backups.
Dim iMaxCopies As Integer 'Max number of timestamped backup files to be retained (per file). See GetiMaxCopies.
Dim sB(200) As String 'Array of file types to possibly backup
'This is to simulate something like this JavaScript syntax: [iVersion].GETsPath()" which allows variable object notation, and which Basic doesn't support.
Dim sSettingsVer As String :sSettingsVer = sSettingsVersion 'AnnotatedBackupsSettings minimum required version - need a variable for the Select Case!
Select Case sSettingsVer
Case 1 'Simple old style moudle name, w/o version suffix
sPath = AnnotatedBackupsSettings.GETsPath()
iMaxCopies = AnnotatedBackupsSettings.GETiMaxCopies()
sB() = AnnotatedBackupsSettings.GETsB()
Case 2 'New style module names, w/ version suffix
sPath = AnnotatedBackupsSettingsV2.GETsPath()
iMaxCopies = AnnotatedBackupsSettingsV2.GETiMaxCopies()
sB() = AnnotatedBackupsSettingsV2.GETsB()
Case 3
sPath = AnnotatedBackupsSettingsV3.GETsPath()
iMaxCopies = AnnotatedBackupsSettingsV3.GETiMaxCopies()
sB() = AnnotatedBackupsSettingsV3.GETsB()
Case 4
sPath = AnnotatedBackupsSettingsV4.GETsPath()
iMaxCopies = AnnotatedBackupsSettingsV4.GETiMaxCopies()
sB() = AnnotatedBackupsSettingsV4.GETsB()
'May have to extend this above someday with more Case statements
'Failsafe if version updated w/o extending the above case statements
Case Is > 4
MsgBox("OOPS, select statement is too short for iVersion = " & iVersion & "." &C2 &_
"Increase the number of case statements to fix this." ,sbOkOnly+sbExclamation ,"FATAL ERROR"):stop
End Select
'=== Now do one or more backups of the current or given file, possibly removing older backups =========
'--- Check for reasonable iMaxCopies and warn if low --------------------------------
'This allows it to be set low for testing code, but then flagged when time to commit.
Dim iMinCopies As Integer :iMinCopies = 10 'Minimum number of copies to keep
Dim iMsgBoxResult As Integer :iMsgBoxResult = sbYes 'Default is to use iMaxCopies as is
If iMaxCopies < iMinCopies Then iMsgBoxResult = MsgBox(_
"iMaxCopies was found to be unexpectedly low (" & iMaxCopies & "); it was probably set this way for testing."_
&C2 & "CANCEL: Cancels this backup so you can stop and fix iMaxCopies."_
&CR & " (iMaxCopies is located in the " & SettingsName(sSettingsName,iVersion) & " module.)"_
&C2 & "OR"_
&C2 & "Proceed with backup and limit (purge) backups to " & iMaxCopies & " copies?"_
&C2 & " YES=DESTRUCTIVE: Use iMaxCopies as is to purge older backups."_
&C2 & " NO=FAILSAFE: Backup, but don't purge any backups."_
&C2 & ""_
,sbYesNoCancel+sbExclamation+sbDefaultButton3 _
,"SETUP SANITY WARNING")
If iMsgBoxResult=sbCancel Then stop
'=sbYes: use iMaxCopies as is (even if low for testing)
'=sbNo : don't purge any backups; only print error message later and stop
'--- Check for non-empty backup path ------------------------------------------------
if sPath = "" Then MsgBox(_
"sPath="""""_
&C2 & "An empty path might cause accidental deletion of your document."_
&C2 & "Fix in this Module:"_
&C2 & " My Macros & Dialogs"_
&CR & " Standard"_
&CR & " AnnotatedBackups"_
&CR & " AnnotatedBackupsSettings"_
,sbOkOnly+sbExclamation _
,"FATAL SETUP ERROR"):stop
'--- Check that no slashes in backup path -------------------------------------------
if instr(sPath,"/") + instr(sPath,"\") Then MsgBox(_
"sPath=""" & sPath & """"_
&C2 & "This relative path should not contain a / or \ (slash or backslash)."_
,sbOkOnly+sbExclamation _
,"FATAL SETUP ERROR"):stop
'--- Get optional comment and honor abort request -----------------------------------
'(do this early, so as not to save or close anything if canceled)
'NOTE this won't wrap like MsgBox will. Instead you are limited to 3 lines only!
Dim sComment As String
sComment = InputBox(_
"(AnnotatedBackups V" & sProgramsVersion _
& " with v" & sSettingsVersion _
& " settings. MaxCopies=" & iMaxCopies & ")" _
&C2 & "Optional comment to append to your backup's file name:" _
,"ENTER OPTIONAL FILENAME ANNOTATION"_
,"none") '"none" is needed because an empty string and a cancel button are the same thing.
If sComment = "" Then Exit Sub
sComment = iif(sComment = "none", "", " " & sComment) 'Remove word 'none', and add leading space to comments
'--- Get document ------------------------------------------------------------------- '
On Error GoTo URL_error
' If Not isObject(ThisComponent) Then MsgBox("ERROR: missing ThisComponent"):stop '??Strange error
Dim oDoc As Object :oDoc = ThisComponent 'Was: "If IsMissing(oDoc) Then Dim oDoc As Object :oDoc = ThisComponent" But, not sure what the If was for as it doesn't work.
DIM sUrl_From AS STRING :sUrl_From = oDoc.URL 'Default From URL
On Error GoTo 0
'--- Adjust oDoc if called from a Base Form, and also close any open Base Forms and Reports, but without chaning oDoc used by other LO modules
' MsgBox "Title: " & oDoc.Title &CR & "URL: " & oDoc.URL &CR & "db: " & oDoc.supportsService("com.sun.star.sdb.OfficeDatabaseDocument") & " parent: " & iif(isnull(oDoc.parent),"null","not"): stop
'app form? state title db parent url
'------ ------- ------- ------------------------------------------- --- ------- ---------------------------------------------------------------------------
'base saved Lookup.odb t missing file:///home/howard/Shared/Data/LO/odb/1.8.0/Demonstrations/Lookup/Lookup.odb
'base saved New Database.odb t missing file:///home/howard/Documents/New%20Database.odb
'base form New Database.odb : Form1 f t "" 'forms don't have URL's
'base form Lookup.odb : Sample search and edit form f t "" 'forms don't have URL's
'calc unsaved Untitled 2 f void "" 'unsaved: no url; & no filename extension!
' saved Untitled 2.ods f void file:///home/howard/Documents/Untitled%202.ods
'draw unsaved Untitled 2 f void ""
' saved Untitled 2.odg f void file:///home/howard/Documents/Untitled%202.odg
'impress unsaved Untitled 2 f void ""
' saved Untitled 2.odp f void file:///home/howard/Documents/Untitled%202.odp
'math unsaved Untitled 2 f void ""
' saved Untitled 2.odf f void file:///home/howard/Documents/Untitled%202.odf
'writer unsaved Untitled 2 f void ""
' saved Untitled 2.odt f void file:///home/howard/Documents/Untitled%202.odt
'Get out of any Base Form, and make sure all Base forms are closed, but without messing up oDoc.URL for other LO Modules
if oDoc.supportsService("com.sun.star.sdb.OfficeDatabaseDocument") then 'If Base (main/outer dialog) (Note: parent doesn't always exist to test, like in Base it isn't there).
iBaseFormsClosed(oDoc) 'so make sure that all forms are closed
Else ' other: A Base Form, or another LO module, i.e. Calc, Draw, Impress, Math, or Writer
If not isnull(oDoc.parent) then 'If a Base form?
'Unravel - allow this to be run from within a Base Form -Note! A new, non-base docuemnt's URL is also empty.
DO WHILE sUrl_From = "" : oDoc = oDoc.Parent :sUrl_From = oDoc.URL :LOOP
iBaseFormsClosed(oDoc) 'so make sure that all forms are closed
End If
End If
'--- Make sure document is saved before proceeding ---------------------------------- '
' If a new document is open (i.e. unsaved), then first save it so we can get its path and filter type
If Not(oDoc.hasLocation) Then
Dim oDocNew As Object :oDocNew = oDoc.CurrentController.Frame
Dim oDispatcher As Object :oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oDocNew, ".uno:SaveAs", "", 0, array()) 'Create a new file
End If
If Not(oDoc.hasLocation) Then MsgBox(_
"Your document was not saved, so backup was not done. "_
&C2 & "(Perhaps you tried saving to an unwritable folder or to a file already in use.)"_
,sbOkOnly+sbExclamation _
,"FATAL ERROR - DOCUMENT WAS NOT SAVED"):stop
' --- Set up pathnames (document to backup and place to back it up) -----------------
' - Get document to backup's name w/ full path
' Retrieve the document name and path from the URL
Dim sDocURL As String :sDocURL = oDoc.getLocation() 'used once below
Dim sDocNameWithFullPath As String :sDocNameWithFullPath = ConvertFromURL(sDocURL) 'Source path/filename
' --- Detect from path if we have "/" (Linux) or "\" (Windows) ----------------------
Dim sSlash As String
Dim sOtherSlash As String
If Instr(1, sDocNameWithFullPath, "/") > 0 _
Then :sSlash = "/" :sOtherSlash = "\" 'Linux
Else :sSlash = "\" :sOtherSlash = "/" 'Windows
End If
' --- extract filename --------------------------------------------------------------
Dim sDocName As String :sDocName = GetFileName(sDocNameWithFullPath, sSlash) 'Source filename
' --- Backup folder -----------------------------------------------------------------
' sPath is relative.
' "foo relative - put backups where document is stored .../basedir/foo/.
' "/foo relative - put backups where document is stored .../basedir/foo/. Note: Leading slash is ok too
Dim i As Integer :i = Len(sDocNameWithFullPath)
'note: Star Basic does not have a instrrev(), so this is the workaround:
While Mid(sDocNameWithFullPath, i, 1) <> sSlash :i=i-1 :Wend 'strip off doc filename to get abs path
Dim sAbsPath As String :sAbsPath = Left(sDocNameWithFullPath, i) & sPath & sSlash & sDocName & sSlash '/DocumentPath/sPath/DocName/
' --- Save current document changes -------------------------------------------------
' Save the current document only if it has changed, is not new (has been saved before) and is not read only
If oDoc.isModified and oDoc.hasLocation and Not(oDoc.isReadOnly) Then oDoc.store()
' --- get timestamp -----------------------------------------------------------------
' the timestamp, so it will be identical for all the backup copies
Dim s_ As String :s_ = iif(sSlash = "/",":","_") 'Allowable hour:time:seconds delimiter for linux or windows
Dim sTimeStamp As String: sTimeStamp = Format(Year( Now), "0000-" ) & _
Format(Month( Now), "00-" ) & _
Format(Day( Now), "00\_" ) & _
Format(Hour( Now), "00"&s_ ) & _
Format(Minute( Now), "00"&s_ ) & _
Format(Second( Now), "00" )
' --- Change illegal file name characters to dashes in comment ----------------------
'(Can't abort now because already passed cancel button, but didn't have filename when we had to ask to proceed)
If sComment<>"" Then
Dim sIllegal() As String
If sSlash="/" Then :sIllegal() = Array("/") 'linux
Else :sIllegal() = Array("/", "\", ":", "*", "?", """", "<", ">", "|") 'Windows
End If
Dim sChar As String
For i=1 to Len(sComment)
For Each sChar in sIllegal()
if Mid(sComment, i, 1) = sChar Then sComment = Left(sComment,i-1) & "-" & Right(sComment,len(sComment)-i
Next sChar
Next i
End If
' --- do other backups --------------------------------------------------------------
' For each file filter, let's see whether we should create a backup copy or not
Dim sBackupName As String
Dim sDocType As String
Dim sExt As String 'file name extension
Dim sSaveToURL As String
i = 1
While sB(i) <> ""
If GetField(sB(i), "|", 1) = "BACKUP" Then 'Future: replace GetField -> split the line once into a array
sDocType = GetField(sB(i), "|", 2)
If _
(sDocType = "Base" And oDoc.supportsService("com.sun.star.sdb.OfficeDatabaseDocument" )) Or _
(sDocType = "Calc" And oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument" )) Or _
(sDocType = "Draw" And oDoc.supportsService("com.sun.star.drawing.DrawingDocument" )) Or _
(sDocType = "Impress" And oDoc.supportsService("com.sun.star.presentation.PresentationDocument" )) Or _
(sDocType = "Math" And oDoc.supportsService("com.sun.star.formula.FormulaProperties" )) Or _
(sDocType = "Writer" And oDoc.supportsService("com.sun.star.text.TextDocument" )) _
Then '??Think this is right enough for formula.*
sExt = GetField(sB(i), "|", 3) 'file name extension (used 2 places)
' --- Check if the backup folder exists, if not we create it ------------------------
On Error Resume Next
MkDir sAbsPath 'Create directory (if not already found)
On Error Goto 0
'Backup name format: name.ext timestamp comment.ext (Note: .ext twice) 'used once below
sBackupName = sDocName & "." & sExt & "--" _
& sTimeStamp & sComment & "." & sExt
sSaveToURL = ConvertToURL(sAbsPath & sBackupName) 'Name to save to (used once below)
On Error Goto StoreToURLError 'Next line fails if original doc is *.xlsx. To fix first save doc as *.ods.
oDoc.storeToUrl(sSaveToURL, Array(MakePropertyValue( "FilterName", GetField(sB(i), "|", 5) ) ) ) 'Now run the filter to write out the file
On Error Goto 0
RenameOlderBackups( sAbsPath, sDocName , sExt, oDoc)
PruneBackupsToMaxSize(iMaxCopies, sAbsPath, sDocName & "." & sExt , sExt, iMsgBoxResult) 'And finally possibly remove older backups to limit number of them kept
End If
End If
i = i + 1
Wend
' --- Backup shared macros to a common area -----------------------------------------
'For OO file operations see: https://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Files_and_Directories_%28Runtime_Library%29
' From root subdir: /home/howard/.config/libreoffice/4/user/basic/* (currently about 240 kb)
' To root subdir: /home/howard/.config/libreoffice/4/user/backups/annotatedbackups/basic/timestamp-comment/*
Dim oPathSettings As Object : oPathSettings = createUnoService("com.sun.star.util.PathSettings")
Dim sFrom As String : sFrom = Split(oPathSettings.Basic ,";")(1) & sSlash
Dim sTo As String : sTo = Split(oPathSettings.Backup,";")(0) & sSlash & _
"annotatedbackups" & sSlash & _
"basic" & sSlash
'Backup My Macros subdirectory (that has the common/shared BASIC code in it)
mkdir(sTo) : FileCopy ( sFrom, sTo & sTimeStamp & " " & sDocName & "." & sExt & sComment & sSlash)
' --- Prune older backup dirs
PruneBackupDirsToMaxSize(iMaxCopies, sTo, iMsgBoxResult) 'And finally possibly remove older backups to limit number of them kept
Exit Sub
'this needs further testing
StoreToURLError:
MsgBox(Error$_
&C2 & "Perhaps your original file was not in an ODF (OpenOffice Document Format), e.g. it might have been in .xlsx"_
,sbOkOnly+sbExclamation ,"SAVE FAILED")
stop
URL_error:
MsgBox(Error$_
&C2 & "This happens during development or testing with the macro editor. When another LO document is opened, "_
& "then closed, then ThisComponent for whatever reason no longer points to anything (even thought we still have another "_
& "document open (i.e. the original document we had open for backup testing)."_
_
&C2 & "To fix it just set the focus on the document to backup, then back here in the basic editor, and re-run this."_
,sbOkOnly+sbExclamation ,ucase("ThisComponent.URL is missing"))
stop
End Sub
'##################################################################################################
'### SUBS AND FUNCTIONS USED ABOVE ################################################################
'##################################################################################################
' === Create setttings module name ================================================================
Function SettingsName(sSettingsName As String, mVer As Variant) As String 'Helps deals with transition from old to new style names
SettingsName = sSettingsName & iif(mVer=1, "", "V" & mVer) 'Version 1 name: 'foo', Version 2-n names: 'fooV2', 'fooV3', etc
End Function
'=== Close any Base forms (prompting user if necessary) ===========================================
Private Sub iBaseFormsClosed(oDoc As Object)
'-End of line characters, (can't make these Const), :-( tip: these don't get passed to subs
Dim C2 As String : C2 = chr(10)&chr(10)
'--- Count design mode: Tables, Queries, Forms & Reports, (i.e. they are inside Frames of Frames in the Desktop)
'Table design:* ToGet.odb : links.address counties, hi - LibreOffice Base: Table Design - LibreOffice Base:
'Table view : links.address cities, hi - ToGet - LibreOffice Base: Table Data View - LibreOffice Base:
'
'Query design:* ToGet.odb : Items to get query - LibreOffice Base: Query Design - LibreOffice Base:
'Query view : Items to get query - ToGet - LibreOffice Base: Table Data View - LibreOffice Base:
'
'Form design:* ToGet.odb : links.items to get - LibreOffice Base: Database Form - LibreOffice Base:
'Form view :* ToGet.odb : links.items to get - LibreOffice Base: Database Form - LibreOffice Base: (same as design!)
'
'Report design:* ToGet.odb : Items to get ok by store report - LibreOffice Base: Oracle Report Builder - LibreOffice Base:
'Report view : (not under this parent)
'
'Truths:
' If "ToGet.odb : " prefix then we need to save this
' If " - LibreOffice Base: Table Design" suffix then it's a table in design
' if " - LibreOffice Base: Query Design" suffix then it's a query in design
' if " - LibreOffice Base: Database Form" suffix then it's a form in design or view
' if " - LibreOffice Base: Oracle Report Builder" suffix then it's a report in design
Dim iOpenTables As Integer :iOpenTables = 0 'Can't auto-close these (not yet at least)
Dim iOpenQueries As Integer :iOpenQueries = 0 'Can't auto-close these (not yet at least)
Dim iOpenForms As Integer :iOpenForms = 0 'Can auto-close these
Dim iOpenReports As Integer :iOpenReports = 0 'Can auto-close these
Dim iFrame As Integer 'Frame index
Dim iFrameSub As Integer 'Sub frame index
Dim oFrames As Object : oFrames = StarDesktop.Frames 'All frames
Dim oFrame As Object 'Each frame
Dim oBaseFrames As Object 'All base frames
Dim oBaseFrame As Object 'Each base frame
Dim sTxt As String : sTxt = "Me: " & oDoc.Title & chr(10)& chr(10) & "Parents / Children:" & chr(10) 'place to compile output
For iFrame=0 To oFrames.Count-1 Step 1
'Looking for titles like: "Lookup5.odb - LibreOffice Base" (First find our parent and ignore all other parents)
oFrame = oFrames.getByIndex(iFrame) : sTxt = sTxt & chr(10) & "--" & oFrame.Title & chr(10)
' If instr(oFrame.Title, oDoc.Title & " - LibreOffice Base")<>0 Then
If isSuffix(oFrame.Title, oDoc.Title & " - LibreOffice Base") Then
oBaseFrames = oFrame.Frames
For iFrameSub=0 To oBaseFrames.Count-1 Step 1
oBaseFrame = oBaseFrames.getByIndex(iFrameSub) : sTxt = sTxt & " " & oBaseFrame.Title & chr(10)
Select Case True
Case True XOR NOT (isSuffix(oBaseFrame.Title," - LibreOffice Base: Table Design" ))
iOpenTables = 1+iOpenTables
Case True XOR NOT (isSuffix(oBaseFrame.Title," - LibreOffice Base: Query Design" ))
iOpenQueries = 1+iOpenQueries
Case True XOR NOT (isSuffix(oBaseFrame.Title," - LibreOffice Base: Database Form" ))
iOpenForms = 1+iOpenForms
Case True XOR NOT (isSuffix(oBaseFrame.Title," - LibreOffice Base: Oracle Report Builder" ))
iOpenReports = 1+iOpenReports
Case Else
MsgBox("Title error: " & oBaseFrame.Title):stop
End Select
Next iFrameSub
End if
Next iFrame
' MsgBox sTxt & chr(10) & "iOpenTables " & iOpenTables _
' & chr(10) & "iOpenQueries " & iOpenQueries _
' & chr(10) & "iOpenForms " & iOpenForms _
' & chr(10) & "iOpenReports " & iOpenReports _
' ': stop
'--- Now if any forms or reports are open (with possibly unsaved edits!) then ask to close them, or abort the backup.
' (Because I can't figure out how to save any current records changes before the backup).
if iOpenForms+iOpenReports Then
If MsgBox( _
iOpenForms & " form" & iif(iOpenForms =1,"","s") & " and "_
&iOpenReports & " report" & iif(iOpenReports=1,"","s")_
& iif(iOpenForms+iOpenReports=1," is open and needs"," are open and need")_
& " to be closed before backup."_
&C2 & "Ok to close " _
& iif(iOpenForms+iOpenReports=1,"it","them") & " now?" _
, sbYesNo + sbQuestion + sbDefaultButton1 _
,"Preparing to backup") = sbNo Then stop
'-Close all my forms & reports (open or not). This is harmless as some of them might already be closed, but I can't tell here which ones.
CloseTree(oDoc.FormDocuments)
CloseTree(oDoc.ReportDocuments)
End If
'I don't yet know how to close Table or Query windows (like w/ Forms above, so for now this warning will have to do)
if iOpenTables+iOpenQueries Then
If MsgBox( _
iOpenTables & " Table" & iif(iOpenTables =1,"" ,"s" ) & " and "_
&iOpenQueries & " Quer" & iif(iOpenQueries =1,"y" ,"ies" ) & iif(iOpenTables+iOpenQueries=1," is"," are")_
& " open & may contain unsaved records."_
&C2 & "Ok to Ignore? Or Cancel to be safe, manually close, & retry?" _
,sbOkCancel+sbQuestion+sbDefaultButton2 _
,"CAUTION!") = sbNo Then stop
'-Close all my Tables & Queries (open or not). This is harmless as some of them might already be closed, but I can't tell here which ones.
End If
End Sub
'--- Close Forms or Reports tree(s) -- (recursive) ------------------------------------------------
Private Sub CloseTree(oDocuments As Object)
' mri oDocuments
If oDocuments.count Then
Dim oDoc As Object 'Holds current item in list
Dim i As Integer 'documents index
For i=0 To oDocuments.count-1
oDoc = oDocuments.getByIndex(i)
' msgbox oDoc.name
If oDoc.ContentType = "" Then
CloseTree(oDoc) 'nest (recurse)
Else
oDoc.close
End If
Next i
End If
End Sub
'--- Test string for a suffix
Private Sub isSuffix(s1 As String, s2 As String) As Boolean 'Look to see if s2 is suffix in s1
' msgbox Right(s1,len(s2))
isSuffix = (Right(s1,len(s2)) = s2)
End Sub
'Private Sub isSuffixTest()
' MsgBox isSuffix("this is a test" , "is a test") 'true
' MsgBox isSuffix("this is a test2", "is a test") 'false
'End Sub
'=== Return filename /wo path or ext ==============================================================
Private Sub GetFileName(byVal sNameWithFullPath as String, byval sSlash as String) as String
Dim i as Long
Dim j as Long
GetFileName = ""
'Search from the end of the full name. "." will indicate the end of the file name and the beginning of the extension
For i = Len(sNameWithFullPath) To 1 Step -1
If Mid(sNameWithFullPath, i, 1) = "." Then
' We have found a ".", so now we continue backwards and search for the path delimiter "\" or "/"
For j = i - 1 to 1 Step -1
If Mid(sNameWithFullPath, j, 1) = sSlash Then
' We have found it, the file name is the
' piece of string between the two
GetFileName = Mid(sNameWithFullPath, j + 1, i - j - 1)
j = 0
i = 0
End If
Next j
End If
Next i
End Sub
'=== Return nth text field =========================================================================
' e.g. n=2 from "xxx|yyy|foo", gives "yyy". (n=0 ok, but returns nothing)
Private Sub GetField(byVal sInput As String, byVal sDelimiter As String, ByVal n As Integer) As String
sInput = sDelimiter & sInput & sDelimiter 'To simplify searching sandwitch the input in outer delimiters
GetField = "" 'Default output if field or is empty found
Dim iStart As Long :iStart = 1 'Char position after nth delimiter
'A) Find the character position of the nth delimiter
Dim i As Integer
For i = 1 to n
iStart = InStr(iStart, sInput, sDelimiter)+1 'Char position after ith delimiter
If iStart = 1 Then Exit Sub 'If search fails, i.e. ran out of delimiters too soon , then silently return an empty string
Next i
If iStart = Len(sInput)+1 Then Exit Sub 'If search fails, i.e. found nth delimiter, but its the last one, then silently return an empty string
'B) Find the character position before the next delimiter
Dim iEnd As Long :iEnd = InStr(iStart, sInput, sDelimiter) 'Char position at found delimiter n+1
'C) Return the portion of string between the two delimiters
GetField = RTrim(Mid(sInput, iStart, iEnd - iStart)) 'Input, Start, Length (ignore extra delimiters we put on)
End Sub
''--Tests to make sure code above is working (uncomment and single step through)
'Sub test_GetField()
' dim s as string
'
' 'These should all return "", except as noted
' s = getfield("" , "|",-1)
' s = getfield("" , "|", 0)
' s = getfield("" , "|", 1)
' s = getfield("" , "|", 2)
' s = getfield("" , "|", 3)
'
' s = getfield("x" , "|",-1)
' s = getfield("x" , "|", 0)
' s = getfield("x" , "|", 1) 'should be "x"
' s = getfield("x" , "|", 2)
' s = getfield("x" , "|", 3)
'
' s = getfield("x|y|z" , "|",-1)
' s = getfield("x|y|z" , "|", 0)
' s = getfield("x|y|z" , "|", 1) 'should be "x"
' s = getfield("x|y|z" , "|", 2) 'should be "y"
' s = getfield("x|y|z" , "|", 3) 'should be "z"
' s = getfield("x|y|z" , "|", 4)
' s = getfield("x|y|z" , "|", 5)
'
' s = getfield("x " , "|", 1) 'should be "x" (should remove mixed trailing tabs and spaces)
' dim i as integer: i =len(s) 'should be 1
'end Sub
'=== Returns file filter type =====================================================================
' Credit: http://www.oooforum.org/forum/viewtopic.phtml?t=52047
Private Sub GetFilterType(byVal sFileName as String) as String
'Get access to UNO methods ("services")
Dim oSFA As Object :oSFA = createUNOService("com.sun.star.ucb.SimpleFileAccess" )
Dim oTD As Object :oTD = createUnoService("com.sun.star.document.TypeDetection" )
'Open given filename for reading
Dim oInpStream As Object :oInpStream = oSFA.openFileRead(ConvertToUrl(sFileName)) 'open given filenmae using ucb.SimpleFileAccess
'Get it's Type
GetFilterType = oTD.queryTypeByDescriptor(MakePropertyValue("InputStream",oInpStream), true) 'queryTypeByDescriptor
oInpStream.closeInput() 'close
End Sub
'=== Create and return a new com.sun.star.beans.PropertyValue =====================================
Private Sub MakePropertyValue(Optional sName As String, Optional sValue As Variant) As com.sun.star.beans.PropertyValue
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
If Not IsMissing(sName ) Then oPropertyValue.Name = sName
If Not IsMissing(sValue ) Then oPropertyValue.Value = sValue
MakePropertyValue() = oPropertyValue
End Sub
' === look for older style names and rename files if found ==============================
'older naming style: ToGet--2017-05-07_22:20:16.odb
'newer naming style: ToGet.odb--2017-05-07_22:20:16.odb (inserted extra .odb to make it easier to un-timestamp name)
Private Sub RenameOlderBackups(sAbsPath As String, sDocName As String, sExt As String, oDoc As Object)
Dim mOlder() As String 'Array to store list of existing older backup path/file names
Dim iOlder As Integer :iOlder = 0 'Count of existing backup files
Dim sName As String
'Get list of older style named backups
sName = Dir(sAbsPath, NormalFiles) 'Get FIRST normal file from pathname
Do While (sName <> "")
'Huristic to test for older style backup name: sDocName(no ext) & -- * sExt where * is: timestamp comment
If _
InStr(sName, sDocName & "--") And _
Right(sName,3 ) = sExt _
Then :ReDIM Preserve mOlder(iOlder) :mOlder(iOlder) = sName :iOlder = iOlder+1 'get list of existing backups
End if
sName = Dir() 'Get NEXT normal file from pathname as initially used above
Loop
'Now rename files in the list to new style names
Dim sNewName As String
For Each sName In mOlder()
sNewName = Left(sName,len(sDocName)) & "." & sExt & right(sName,len(sName)-len(sDocName))
Name sAbsPath & sName As sAbsPath & sNewName 'rename file: Name OldName As NewName
Next sName
End Sub
' === possibly remove older backups =====================================================
Private Sub PruneBackupsToMaxSize(iMaxCopies As Integer, sAbsPath As String, sDocNameExt As String, sExt As String, ByVal iMsgBoxResult As Integer)
'ByVal - so below can't modify it in the caller!
if iMaxCopies = 0 then exit sub 'If iMaxCopies is = 0, there is no need to read, sort or delete any files.
' --- First get list of existing backups --------------------------------------------
Dim mArray() As String 'Array to store list of existing backup path/file names
Dim iBackups As Integer :iBackups = 0 'Count of existing backup files
Dim sName As String :sName = Dir(sAbsPath, NormalFiles) 'Get FIRST normal file from pathname
Do While (sName <> "")
'Huristic to test for deletable backups, finds: sDocNameExt & -- * sExt where * is: timestamp comment
If _
Left(sName,Len(sDocNameExt)+2 ) = sDocNameExt & "--" And _
Right(sName,3 ) = sExt _
Then :ReDIM Preserve mArray(iBackups) :mArray(iBackups) = sName :iBackups = iBackups+1 'get list of existing backups
End if
sName = Dir() 'Get NEXT normal file from pathname as initially used above
Loop
'--- iMaxCopies < iMinCopies AND test mode: don't purge files, only report results --
Dim C2 As String : C2 = chr(10)&chr(10)
If iMsgBoxResult = sbNo Then msgbox("New document backup saved, but didn't purge any older backups. "_
&C2 & iBackups & " document backups found. iMaxCopies limit set to " & iMaxCopies & " backups."_
,,"RESULTS") : Exit Sub
'--- compute # to delete, and exit now if none (do after the check above, so check always runs)
Dim iKill As Integer :iKill = iBackups - iMaxCopies : if iKill <1 then Exit Sub '# of old backups to delete
'--- Warn before deleting more than one backup---------------------------------------
'Failsave check: This is incase iMaxCopies is reduced for testing, or other unforseen bug occurs.
'Note: re-use var iMsgBoxResult here for a new function
If iKill > 1 Then iMsgBoxResult = MsgBox(_
"Only purge the oldest document backup? (No to Purge " & iKill & " older backups.)"_
&C2 & "After a backup in order to limit the total number of backups saved, normally "_
& "the oldest backup might be removed. But perhaps you recently decreased "_
& "iMaxCopies which could trigger this question." _
,sbYesNo+sbExclamation+sbDefaultButton1 _
,"UNEXPECTED DOCUMENT BACKUP DELETION REQUEST")
If iMsgBoxResult = sbYes Then iKill=1
'--- Deleting oldest files ----------------------------------------------------------
'Deletes oldest files exceeding the limit set in iMaxCopies
iSort(mArray) 'Sort list of existing backups (by timestamp, oldest first)
Dim i As Integer :For i = 0 to iKill -1: Kill(sAbsPath & mArray(i)): Next i 'now delete oldest ones as necessary
End Sub
' === possibly remove older backups =====================================================
'And finally possibly remove older backups to limit number of them kept
Private Sub PruneBackupDirsToMaxSize(iMaxCopies As Integer, sAbsPath As String, ByVal iMsgBoxResult As Integer)
'ByVal - so below can't modify it in the caller!
if iMaxCopies = 0 then exit sub 'If iMaxCopies is = 0, there is no need to read, sort or delete any files.
' --- First get list of existing backups --------------------------------------------
Dim mArray() As String 'Array to store list of existing backup path/file names
Dim iBackups As Integer :iBackups = 0 'Count of existing backup files
Dim sName As String :sName = Dir(sAbsPath, SubDirsDirs) 'Get FIRST normal file from pathname
Do While (sName <> "")
if sName <> "." And sName <> ".." Then
ReDIM Preserve mArray(iBackups) :mArray(iBackups) = sName :iBackups = iBackups+1 'get list of existing backups
End If
sName = Dir() 'Get NEXT normal file from pathname as initially used above
Loop
'--- iMaxCopies < iMinCopies AND test mode: don't purge files, only report results --
Dim C2 As String : C2 = chr(10)&chr(10)
If iMsgBoxResult = sbNo Then msgbox("New My Macros backup saved, but didn't purge any older backups. "_
&C2 & iBackups & " My Macros backups found. iMaxCopies limit set to " & iMaxCopies & " backups."_
,,"RESULTS") : Exit Sub
'--- compute # to delete, and exit now if none (do after the check above, so check always runs)
Dim iKill As Integer :iKill = iBackups - iMaxCopies : if iKill <1 then Exit Sub '# of old backups to delete
'--- Warn before deleting more than one backup---------------------------------------
'Failsave check: This is incase iMaxCopies is reduced for testing, or other unforseen bug occurs.
'Note: re-use var iMsgBoxResult here for a new function
If iKill > 1 Then iMsgBoxResult = MsgBox(_
"Only purge the oldest My Macros backup? (No to Purge " & iKill & " older backups.)"_
&C2 & "After a backup in order to limit the total number of backups saved, normally "_
& "the oldest backup might be removed. But perhaps you recently decreased "_
& "iMaxCopies which could trigger this question." _
,sbYesNo+sbExclamation+sbDefaultButton1 _
,"UNEXPECTED MY MACROS BACKUP DELETION REQUEST")
If iMsgBoxResult = sbYes Then iKill=1
'--- Deleting oldest files ----------------------------------------------------------
'Deletes oldest files exceeding the limit set in iMaxCopies
iSort(mArray) 'Sort list of existing backups (by timestamp, oldest first)
Dim i As Integer :For i = 0 to iKill -1: RmDir(sAbsPath & mArray(i)): Next i 'now delete oldest ones as necessary
End Sub
'=== insertion sort (oldest first) ================================================================
Private Sub iSort(mArray)
Dim Lb as integer :Lb = lBound(mArray) 'lower array bound
Dim Ub as integer :Ub = uBound(mArray) 'upper array bound
Dim iT As Long 'element under Test , Array index - What we are looking to possibly move and insert into lower already sorted stuff
Dim sT as string 'element under Test , Element value - Variable to hold what we are testing, so cell can get stomped on and not lost by stuff shifting up
Dim iC as Long 'element to Compare , Array index - Index to search thru what is already sorted, to find what might be bigger than sT
for iT = Lb+1 to Ub 'Work forwards through array: from second element to last element
sT = mArray(iT) 'Save element to test and possibly to move down (because will possibly get stomped on).
For iC = iT-1 to Lb step -1 'Search backwards thru what's already sorted until we're less than what we are finding.
If strComp(mArray(iC), sT, 0) < 1 Then Exit For 'strComp returns -1 when mArray(iC) < t; Exit loop because we found insertion place
mArray(iC+1) = mArray(iC) 'otherwise shift elements up 1 and step down and repeat the test
Next iC
mArray(iC+1) = sT 'Finally, insert moved element here (might even be the very first position)
Next iT
End Sub
''--Test of iSort()
'Sub test_iSort()
' Dim mArrayA(2) As String
' mArrayA(0) = "x3"
' mArrayA(1) = "x2"
' mArrayA(2) = "x1"
' iSort(mArrayA)
' Dim x0 As String :x0 = mArrayA(0)
' Dim x1 As String :x1 = mArrayA(1)
' Dim x2 As String :x2 = mArrayA(2)
'End Sub
' === Trim spaces and tabs from right end =========================================================
Private Sub RTrim(str As String) As String
RTrim=str 'simplify code; use returned value as working string
Dim i as Long 'character counter (from end to start)
For i = Len(RTrim) to 1 step -1
If right(RTrim,1) <> chr(9) and right(RTrim,1) <> " " Then Exit Sub 'if trailing white space not found we're done
RTrim = left(RTrim,len(RTrim)-1) 'otherwise remove trailing white space, step left, repeat
Next
End Sub
' === Insert substring in string ==================================================================
'-Insert substring within string after delimiter
Function InsertAtDelimiter (sStr As String, sSubStr As String, sDelimiter As String) As String
InsertAtDelimiter = InsertSubString(sStr, sSubStr, InStr(1,sStr,sDelimiter) + len(sDelimiter))
End Function
'-Insert substring within string at position
Function InsertSubString (Str As String, sSubStr As String, iPosition As Long) As String
InsertSubString = Left(Str,iPosition) & sSubStr & Right(Str,len(Str)-iPosition+1)
End Function
' === Math functions ==============================================================================
Function Max (x As Long, y as Long) As Long
Max = IIf(x > y, x, y)
End Function
' === Copy code below and use it to create a new settings module of the given version =============
Sub CreateSettingsModule(oLib As Object, sProgramsName As String, sSettingsNameV As String, sProgramsVersion As String)
'-End of line characters, (can't make these Const), :-( tip: these don't get passed to subs
Dim CR As String : CR = chr(10)
Dim C2 As String : C2 = chr(10)&chr(10)
' mri oLib:stop
'Extract this file's code (Basic) in text
Dim sDelimiter As String :sDelimiter = "'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"&CR
Dim sProgramsSource As String :sProgramsSource = oLib.getByName(sProgramsName) 'text of this entire file