wizards/source/access2base/Trace.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Trace" script:language="StarBasic">REM =======================================================================================================================
   4 REM ===                                 The Access2Base library is a part of the LibreOffice project.                                                                   ===
   5 REM ===                                 Full documentation is available on http://www.access2base.com                                                                   ===
   6 REM =======================================================================================================================
   7
   8 Option Explicit
   9
  10 Public Const cstLogMaxEntries = 20
  11
  12 REM Typical Usage
  13 REM             TraceLog(&quot;INFO&quot;, &quot;The OK button was pressed&quot;)
  14 REM
  15 REM Typical Usage for error logging
  16 REM             Sub MySub()
  17 REM                     On Local Error GoTo Error_Sub
  18 REM                     ...
  19 REM             Exit_Sub:
  20 REM                     Exit Sub
  21 REM             Error_Sub:
  22 REM                     TraceError(&quot;ERROR&quot;, Err, &quot;MySub&quot;, Erl)
  23 REM                     GoTo Exit_Sub
  24 REM             End Sub
  25 REM
  26 REM     To display the current logged traces and/or to set parameters
  27 REM             TraceConsole()
  28
  29 REM -----------------------------------------------------------------------------------------------------------------------
  30 Public Sub TraceConsole()
  31 &apos;  Display the Trace dialog with current trace log values and parameter choices
  32         If _ErrorHandler() Then On Local Error Goto Error_Sub
  33
  34 Dim sLineBreak As String, oTraceDialog As Object
  35         sLineBreak = vbNewLine
  36
  37         Set oTraceDialog = CreateUnoDialog(Utils._GetDialogLib().dlgTrace)
  38         oTraceDialog.Title = _GetLabel(&quot;DLGTRACE_TITLE&quot;)      &apos;  HelpText ???
  39
  40 Dim oEntries As Object, oTraceLog As Object, oClear As Object, oMinLevel As Object, oNbEntries As Object, oDump As Object
  41 Dim oControl As Object
  42 Dim i As Integer, sText As String, iOKCancel As Integer
  43
  44         Set oNbEntries = oTraceDialog.Model.getByName(&quot;numNbEntries&quot;)
  45         oNbEntries.Value = _A2B_.TraceLogCount
  46         oNbEntries.HelpText = _GetLabel(&quot;DLGTRACE_LBLNBENTRIES_HELP&quot;)
  47
  48         Set oControl = oTraceDialog.Model.getByName(&quot;lblNbEntries&quot;)
  49         oControl.Label = _GetLabel(&quot;DLGTRACE_LBLNBENTRIES_LABEL&quot;)
  50         oControl.HelpText = _GetLabel(&quot;DLGTRACE_LBLNBENTRIES_HELP&quot;)
  51
  52         Set oEntries = oTraceDialog.Model.getByName(&quot;numEntries&quot;)
  53         If _A2B_.TraceLogMaxEntries = 0 Then _A2B_.TraceLogMaxEntries = cstLogMaxEntries
  54         oEntries.Value = _A2B_.TraceLogMaxEntries
  55         oEntries.HelpText = _GetLabel(&quot;DLGTRACE_LBLENTRIES_HELP&quot;)
  56
  57         Set oControl = oTraceDialog.Model.getByName(&quot;lblEntries&quot;)
  58         oControl.Label = _GetLabel(&quot;DLGTRACE_LBLENTRIES_LABEL&quot;)
  59         oControl.HelpText = _GetLabel(&quot;DLGTRACE_LBLENTRIES_HELP&quot;)
  60
  61         Set oDump = oTraceDialog.Model.getByName(&quot;cmdDump&quot;)
  62         oDump.Enabled = 0
  63         oDump.Label = _GetLabel(&quot;DLGTRACE_CMDDUMP_LABEL&quot;)
  64         oDump.HelpText = _GetLabel(&quot;DLGTRACE_CMDDUMP_HELP&quot;)
  65
  66         Set oTraceLog = oTraceDialog.Model.getByName(&quot;txtTraceLog&quot;)
  67         oTraceLog.HelpText = _GetLabel(&quot;DLGTRACE_TXTTRACELOG_HELP&quot;)
  68         If UBound(_A2B_.TraceLogs) &gt;= 0 Then                 &apos;  Array yet initialized
  69                 oTraceLog.HardLineBreaks = True
  70                 sText = &quot;&quot;
  71                 If _A2B_.TraceLogCount &gt; 0 Then
  72                         If _A2B_.TraceLogCount &lt; _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
  73                         Do
  74                                 If i &lt; _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
  75                                 If Len(_A2B_.TraceLogs(i)) &gt; 11 Then
  76                                         sText = sText &amp; Right(_A2B_.TraceLogs(i), Len(_A2B_.TraceLogs(i)) - 11) &amp; sLineBreak            &apos;  Skip date in display
  77                                 End If
  78                         Loop While i &lt;&gt; _A2B_.TraceLogLast
  79                         oDump.Enabled = 1               &apos;  Enable DumpToFile only if there is something to dump
  80                 End If
  81                 If Len(sText) &gt; 0 Then sText = Left(sText, Len(sText) - Len(sLineBreak))     &apos;  Skip last linefeed
  82                 oTraceLog.Text = sText
  83         Else
  84                 oTraceLog.Text = _GetLabel(&quot;DLGTRACE_TXTTRACELOG_TEXT&quot;)
  85         End If
  86
  87         Set oClear = oTraceDialog.Model.getByName(&quot;chkClear&quot;)
  88         oClear.State = 0                &apos;  Unchecked
  89         oClear.HelpText = _GetLabel(&quot;DLGTRACE_LBLCLEAR_HELP&quot;)
  90
  91         Set oControl = oTraceDialog.Model.getByName(&quot;lblClear&quot;)
  92         oControl.Label = _GetLabel(&quot;DLGTRACE_LBLCLEAR_LABEL&quot;)
  93         oControl.HelpText = _GetLabel(&quot;DLGTRACE_LBLCLEAR_HELP&quot;)
  94
  95         Set oMinLevel = oTraceDialog.Model.getByName(&quot;cboMinLevel&quot;)
  96         If _A2B_.MinimalTraceLevel = 0 Then _A2B_.MinimalTraceLevel = _TraceLevel(TRACEERRORS)
  97         oMinLevel.Text = _TraceLevel(_A2B_.MinimalTraceLevel)
  98         oMinLevel.HelpText = _GetLabel(&quot;DLGTRACE_LBLMINLEVEL_HELP&quot;)
  99
 100         Set oControl = oTraceDialog.Model.getByName(&quot;lblMinLevel&quot;)
 101         oControl.Label = _GetLabel(&quot;DLGTRACE_LBLMINLEVEL_LABEL&quot;)
 102         oControl.HelpText = _GetLabel(&quot;DLGTRACE_LBLMINLEVEL_HELP&quot;)
 103
 104         Set oControl = oTraceDialog.Model.getByName(&quot;cmdOK&quot;)
 105         oControl.Label = _GetLabel(&quot;DLGTRACE_CMDOK_LABEL&quot;)
 106         oControl.HelpText = _GetLabel(&quot;DLGTRACE_CMDOK_HELP&quot;)
 107
 108         Set oControl = oTraceDialog.Model.getByName(&quot;cmdCancel&quot;)
 109         oControl.Label = _GetLabel(&quot;DLGTRACE_CMDCANCEL_LABEL&quot;)
 110         oControl.HelpText = _GetLabel(&quot;DLGTRACE_CMDCANCEL_HELP&quot;)
 111
 112         iOKCancel = oTraceDialog.Execute()
 113
 114         Select Case iOKCancel
 115                 Case 1                                  &apos;  OK
 116                         If oClear.State = 1 Then
 117                                 _A2B_.TraceLogs() = Array()             &apos;  Erase logged traces
 118                                 _A2B_.TraceLogCount = 0
 119                         End If
 120                         If oMinLevel.Text &lt;&gt; &quot;&quot; Then _A2B_.MinimalTraceLevel = _TraceLevel(oMinLevel.Text)
 121                         If oEntries.Value &lt;&gt; 0 And oEntries.Value &lt;&gt; _A2B_.TraceLogMaxEntries Then
 122                                 _A2B_.TraceLogs() = Array()
 123                                 _A2B_.TraceLogMaxEntries = oEntries.Value
 124                         End If
 125                 Case 0                                  &apos;  Cancel
 126                 Case Else
 127         End Select
 128
 129 Exit_Sub:
 130         If Not IsNull(oTraceDialog) Then oTraceDialog.Dispose()
 131         Exit Sub
 132 Error_Sub:
 133         With _A2B_
 134                 .TraceLogs() = Array()
 135                 .TraceLogCount = 0
 136                 .TraceLogLast = 0
 137         End With
 138         GoTo Exit_Sub
 139 End Sub         &apos;  TraceConsole    V1.1.0
 140
 141 REM -----------------------------------------------------------------------------------------------------------------------
 142 Public Sub TraceError(ByVal psErrorLevel As String _
 143                                                 , ByVal piErrorCode As Integer _
 144                                                 , ByVal psErrorProc As String _
 145                                                 , ByVal piErrorLine As Integer _
 146                                                 , ByVal Optional pvMsgBox As Variant _
 147                                                 , ByVal Optional pvArgs As Variant _
 148                                                 )
 149 &apos;  store error codes in trace buffer
 150
 151         On Local Error Resume Next
 152         If IsEmpty(_A2B_) Then Call Application._RootInit()     &apos;  First use of Access2Base in current LibO/AOO session
 153
 154 Dim sErrorText As String, sErrorDesc As String, oDb As Object
 155         sErrorDesc = _ErrorMessage(piErrorCode, pvArgs)
 156         sErrorText = _GetLabel(&quot;ERR#&quot;) &amp; CStr(piErrorCode) _
 157                                                         &amp; &quot; (&quot; &amp; sErrorDesc &amp; &quot;) &quot; &amp; _GetLabel(&quot;ERROCCUR&quot;) _
 158                                                         &amp; Iif(piErrorLine &gt; 0, &quot; &quot; &amp; _GetLabel(&quot;ERRLINE&quot;) &amp; &quot; &quot; &amp; CStr(piErrorLine), &quot;&quot;) _
 159                                                         &amp; Iif(psErrorProc &lt;&gt; &quot;&quot;, &quot; &quot; &amp; _GetLabel(&quot;ERRIN&quot;) &amp; &quot; &quot; &amp; psErrorProc, Iif(_A2B_.CalledSub = &quot;&quot;, &quot;&quot;, &quot; &quot; &amp; _Getlabel(&quot;ERRIN&quot;) &amp; &quot; &quot; &amp; _A2B_.CalledSub))
 160         If IsMissing(pvMsgBox) Then pvMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
 161         TraceLog(psErrorLevel, sErrorText, pvMsgBox)
 162
 163         &apos;  Unexpected error detected in user program or in Access2Base
 164         If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then
 165                 _A2B_.CalledSub = &quot;&quot;
 166                 If psErrorLevel = TRACEFATAL Then
 167                         Set oDb = Application.CurrentDb()
 168                         If Not IsNull(oDb) Then oDb.CloseAllrecordsets()
 169                 End If
 170                 Stop
 171         End If
 172
 173 End Sub         &apos;  TraceError      V0.9,5
 174
 175 REM -----------------------------------------------------------------------------------------------------------------------
 176 Public Sub TraceLevel(ByVal Optional psTraceLevel As String)
 177 &apos;  Set trace level to argument
 178
 179         If _ErrorHandler() Then On Local Error Goto Error_Sub
 180         Select Case True
 181                 Case IsMissing(psTraceLevel)            :               psTraceLevel = &quot;ERROR&quot;
 182                 Case psTraceLevel = &quot;&quot;                                :               psTraceLevel = &quot;ERROR&quot;
 183                 Case Utils._InList(UCase(psTraceLevel), Array( _
 184                         TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT _
 185                         ))
 186                 Case Else                                                       :               Goto Exit_Sub
 187         End Select
 188         _A2B_.MinimalTraceLevel = _TraceLevel(psTraceLevel)
 189
 190 Exit_Sub:
 191         Exit Sub
 192 Error_Sub:
 193         With _A2B_
 194                 .TraceLogs() = Array()
 195                 .TraceLogCount = 0
 196                 .TraceLogLast = 0
 197         End With
 198         GoTo Exit_Sub
 199 End Sub                 &apos;  TraceLevel      V0.9.5
 200
 201 REM -----------------------------------------------------------------------------------------------------------------------
 202 Public Sub TraceLog(Byval psTraceLevel As String _
 203                                                 , ByVal psText As String _
 204                                                 , ByVal Optional pbMsgBox As Boolean _
 205                                                 )
 206 &apos;  Store Text in trace log (circular buffer)
 207
 208         If _ErrorHandler() Then On Local Error Goto Error_Sub
 209 Dim vTraceLogs() As String, sTraceLevel As String
 210
 211         With _A2B_
 212                 If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS)
 213                 If _TraceLevel(psTraceLevel) &lt; .MinimalTraceLevel Then Exit Sub
 214
 215                 If UBound(.TraceLogs) = -1 Then                         &apos;          Initialize TraceLog
 216                         If .TraceLogMaxEntries = 0 Then .TraceLogMaxEntries = cstLogMaxEntries
 217
 218                         Redim vTraceLogs(0 To .TraceLogMaxEntries - 1)
 219                         .TraceLogs = vTraceLogs
 220                         .TraceLogCount = 0
 221                         .TraceLogLast = -1
 222                         If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS)            &apos;  Set default value
 223                 End If
 224
 225                 .TraceLogLast = .TraceLogLast + 1
 226                 If .TraceLogLast &gt; UBound(.TraceLogs) Then .TraceLogLast = LBound(.TraceLogs)                        &apos;  Circular buffer
 227                 If Len(psTraceLevel) &gt; 7 Then sTraceLevel = Left(psTraceLevel, 7) Else sTraceLevel = psTraceLevel &amp; Spc(8 - Len(psTraceLevel))
 228                 .TraceLogs(.TraceLogLast) = Format(Now(), &quot;YYYY-MM-DD hh:mm:ss&quot;) &amp; &quot; &quot; &amp; sTraceLevel &amp; psText
 229                 If .TraceLogCount &lt;= UBound(.TraceLogs) Then .TraceLogCount = .TraceLogCount + 1             &apos;  # of active entries
 230         End With
 231
 232         If IsMissing(pbMsgBox) Then pbMsgBox = True
 233 Dim iMsgBox As Integer
 234         If pbMsgBox Then
 235                 Select Case psTraceLevel
 236                         Case TRACEINFO:                                                 iMsgBox = vbInformation
 237                         Case TRACEERRORS, TRACEWARNING:                 iMsgBox = vbExclamation
 238                         Case TRACEFATAL, TRACEABORT:                    iMsgBox = vbCritical
 239                         Case Else:                                                              iMsgBox = vbInformation
 240                 End Select
 241                 MsgBox psText, vbOKOnly + iMsgBox, psTraceLevel
 242         End If
 243
 244 Exit_Sub:
 245         Exit Sub
 246 Error_Sub:
 247         With _A2B_
 248                 .TraceLogs() = Array()
 249                 .TraceLogCount = 0
 250                 .TraceLogLast = 0
 251         End With
 252         GoTo Exit_Sub
 253 End Sub                 &apos;  TraceLog        V0.9.5
 254
 255
 256 REM -----------------------------------------------------------------------------------------------------------------------
 257 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 258 REM -----------------------------------------------------------------------------------------------------------------------
 259
 260 Private Sub _DumpToFile(oEvent As Object)
 261 &apos;          Execute the Dump To File command from the Trace dialog
 262 &apos;          Modified from Andrew Pitonyak&apos;s Base Macro Programming §10.4
 263
 264
 265         If _ErrorHandler() Then On Local Error GoTo Error_Sub
 266
 267 Dim sPath as String, iFileNumber As Integer, i As Integer
 268
 269         sPath = _PromptFilePicker(&quot;txt&quot;)
 270         If sPath &lt;&gt; &quot;&quot; Then                     &apos;  Save button pressed
 271                 If UBound(_A2B_.TraceLogs) &gt;= 0 Then                 &apos;  Array yet initialized
 272                         iFileNumber = FreeFile()
 273                         Open sPath For Append Access Write Lock Read As iFileNumber
 274                         If _A2B_.TraceLogCount &gt; 0 Then
 275                                 If _A2B_.TraceLogCount &lt; _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
 276                                 Do
 277                                         If i &lt; _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
 278                                         Print #iFileNumber _A2B_.TraceLogs(i)
 279                                 Loop While i &lt;&gt; _A2B_.TraceLogLast
 280                         End If
 281                         Close iFileNumber
 282                         MsgBox _GetLabel(&quot;SAVECONSOLEENTRIES&quot;), vbOK + vbInformation, _GetLabel(&quot;SAVECONSOLE&quot;)
 283                 End If
 284         End If
 285
 286 Exit_Sub:
 287         Exit Sub
 288 Error_Sub:
 289         TraceError(&quot;ERROR&quot;, Err, &quot;DumpToFile&quot;, Erl)
 290         GoTo Exit_Sub
 291 End Sub                 &apos;  DumpToFile              V0.8.5
 292
 293 REM -----------------------------------------------------------------------------------------------------------------------
 294 Public Function _ErrorHandler(Optional ByVal pbCheck As Boolean) As Boolean
 295 &apos; Indicate if error handler is activated or not
 296 &apos; When argument present set error handler
 297         If IsEmpty(_A2B_) Then Call Application._RootInit()     &apos;  First use of Access2Base in current LibO/AOO session
 298         If Not IsMissing(pbCheck) Then _A2B_.ErrorHandler = pbCheck
 299         _ErrorHandler = _A2B_.ErrorHandler
 300         Exit Function
 301 End Function
 302
 303 REM -----------------------------------------------------------------------------------------------------------------------
 304 Private Function _ErrorMessage(ByVal piErrorNumber As Integer, Optional ByVal pvArgs As Variant) As String
 305 &apos;  Return error message corresponding to ErrorNumber (standard or not)
 306 &apos;  and replaces %0, %1, ... , %9 by psArgs(0), psArgs(1), ...
 307
 308 Dim sErrorMessage As String, i As Integer, sErrLabel
 309         _ErrorMessage = &quot;&quot;
 310         If piErrorNumber &gt; ERRINIT Then
 311                 sErrLabel = &quot;ERR&quot; &amp; piErrorNumber
 312                 sErrorMessage = _Getlabel(sErrLabel)
 313                 If Not IsMissing(pvArgs) Then
 314                         If Not IsArray(pvArgs) Then
 315                                 sErrorMessage = Join(Split(sErrorMessage, &quot;%0&quot;), Utils._CStr(pvArgs, False))
 316                         Else
 317                                 For i = LBound(pvArgs) To UBound(pvArgs)
 318                                         sErrorMessage = Join(Split(sErrorMessage, &quot;%&quot; &amp; i), Utils._CStr(pvArgs(i), False))
 319                                 Next i
 320                         End If
 321                 End If
 322         Else
 323                 sErrorMessage = Error(piErrorNumber)
 324                 &apos;  Most (or all?) error messages terminate with a &quot;.&quot;
 325                 If Len(sErrorMessage) &gt; 1 And Right(sErrorMessage, 1) = &quot;.&quot; Then sErrorMessage = Left(sErrorMessage, Len(sErrorMessage)-1)
 326         End If
 327
 328         _ErrorMessage = sErrorMessage
 329         Exit Function
 330
 331 End Function    &apos;  ErrorMessage    V0.8.9
 332
 333 REM -----------------------------------------------------------------------------------------------------------------------
 334 Public Function _PromptFilePicker(ByVal psSuffix As String) As String
 335 &apos;          Prompt for output file name
 336 &apos;          Return &quot;&quot; if Cancel
 337 &apos;          Modified from Andrew Pitonyak&apos;s Base Macro Programming §10.4
 338
 339         If _ErrorHandler() Then On Local Error GoTo Error_Function
 340
 341 Dim oFileDialog as Object, oUcb as object, oPath As Object
 342 Dim iAccept as Integer, sInitPath as String
 343
 344         Set oFileDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FilePicker&quot;)
 345         oFileDialog.Initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION))
 346         Set oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
 347
 348         oFileDialog.appendFilter(&quot;*.&quot; &amp; psSuffix, &quot;*.&quot; &amp; psSuffix)
 349         oFileDialog.appendFilter(&quot;*.*&quot;, &quot;*.*&quot;)
 350         oFileDialog.setCurrentFilter(&quot;*.&quot; &amp; psSuffix)
 351         Set oPath = createUnoService(&quot;com.sun.star.util.PathSettings&quot;)
 352         sInitPath = oPath.Work          &apos;  Probably My Documents
 353         If oUcb.Exists(sInitPath) Then oFileDialog.SetDisplayDirectory(sInitPath)
 354
 355         iAccept = oFileDialog.Execute()
 356
 357         _PromptFilePicker = &quot;&quot;
 358         If iAccept = 1 Then                     &apos;  Save button pressed
 359                 _PromptFilePicker = oFileDialog.Files(0)
 360         End If
 361
 362 Exit_Function:
 363         If Not IsEmpty(oFileDialog) And Not IsNull(oFileDialog) Then oFileDialog.Dispose()
 364         Exit Function
 365 Error_Function:
 366         TraceError(&quot;ERROR&quot;, Err, &quot;PromptFilePicker&quot;, Erl)
 367         GoTo Exit_Function
 368 End Function                    &apos;  PromptFilePicker        V0.8.5
 369
 370 REM -----------------------------------------------------------------------------------------------------------------------
 371 Public Sub _TraceArguments(Optional psCall As String)
 372 &apos;  Process the ERRMISSINGARGUMENTS error
 373 &apos;  psCall is present if error detected before call to _SetCalledSub
 374
 375         If Not IsMissing(psCall) Then Utils._SetCalledSub(psCall)
 376         TraceError(TRACEFATAL, ERRMISSINGARGUMENTS, Utils._CalledSub(), 0)
 377         Exit Sub
 378
 379 End Sub                 &apos;  TraceArguments
 380
 381 REM -----------------------------------------------------------------------------------------------------------------------
 382 Private Function _TraceLevel(ByVal pvTraceLevel As Variant) As Variant
 383 &apos;  Convert string trace level to numeric value or the opposite
 384
 385 Dim vTraces As Variant, i As Integer
 386         vTraces = Array(TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT, TRACEANY)
 387
 388         Select Case VarType(pvTraceLevel)
 389                 Case vbString
 390                         _TraceLevel = 4         &apos;  4 = Default
 391                         For i = 0 To UBound(vTraces)
 392                                 If UCase(pvTraceLevel) = UCase(vTraces(i)) Then
 393                                         _TraceLevel = i + 1
 394                                         Exit For
 395                                 End If
 396                         Next i
 397                 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
 398                         If pvTraceLevel &lt; 1 Or pvTraceLevel &gt; UBound(vTraces) + 1 Then _TraceLevel = TRACEERRORS Else _TraceLevel = vTraces(pvTraceLevel - 1)
 399         End Select
 400
 401 End Function    &apos;  TraceLevel
 402
 403 </script:module>