/usr/lib/libreoffice/share/basic/Access2Base/Trace.xba is in libreoffice-base 1:4.3.3-2+deb8u11.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Trace" script:language="StarBasic">REM =======================================================================================================================
REM === The Access2Base library is a part of the LibreOffice project. ===
REM === Full documentation is available on http://www.access2base.com ===
REM =======================================================================================================================
Option Explicit
Public Const cstLogMaxEntries = 20
REM Typical Usage
REM TraceLog("INFO", "The OK button was pressed")
REM
REM Typical Usage for error logging
REM Sub MySub()
REM On Local Error GoTo Error_Sub
REM ...
REM Exit_Sub:
REM Exit Sub
REM Error_Sub:
REM TraceError("ERROR", Err, "MySub", Erl)
REM GoTo Exit_Sub
REM End Sub
REM
REM To display the current logged traces and/or to set parameters
REM TraceConsole()
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub TraceConsole()
' Display the Trace dialog with current trace log values and parameter choices
If _ErrorHandler() Then On Local Error Goto Error_Sub
Dim sLineBreak As String, oDialogLib As Object, oTraceDialog As Object
sLineBreak = Chr(10)
Set oDialogLib = DialogLibraries
If oDialogLib.hasByName("Access2BaseDev") Then
If Not oDialogLib.IsLibraryLoaded("Access2BaseDev") Then oDialogLib.loadLibrary("Access2BaseDev")
Set oTraceDialog = CreateUnoDialog(DialogLibraries.Access2BaseDev.dlgTrace)
Else
If Not oDialogLib.IsLibraryLoaded("Access2Base") Then oDialogLib.loadLibrary("Access2Base")
Set oTraceDialog = CreateUnoDialog(DialogLibraries.Access2Base.dlgTrace)
EndIf
oTraceDialog.Title = _GetLabel("DLGTRACE_TITLE") ' HelpText ???
Dim oEntries As Object, oTraceLog As Object, oClear As Object, oMinLevel As Object, oNbEntries As Object, oDump As Object
Dim oControl As Object
Dim i As Integer, sText As String, iOKCancel As Integer
Set oNbEntries = oTraceDialog.Model.getByName("numNbEntries")
oNbEntries.Value = _A2B_.TraceLogCount
oNbEntries.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
Set oControl = oTraceDialog.Model.getByName("lblNbEntries")
oControl.Label = _GetLabel("DLGTRACE_LBLNBENTRIES_LABEL")
oControl.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
Set oEntries = oTraceDialog.Model.getByName("numEntries")
If _A2B_.TraceLogMaxEntries = 0 Then _A2B_.TraceLogMaxEntries = cstLogMaxEntries
oEntries.Value = _A2B_.TraceLogMaxEntries
oEntries.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
Set oControl = oTraceDialog.Model.getByName("lblEntries")
oControl.Label = _GetLabel("DLGTRACE_LBLENTRIES_LABEL")
oControl.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
Set oDump = oTraceDialog.Model.getByName("cmdDump")
oDump.Enabled = 0
oDump.Label = _GetLabel("DLGTRACE_CMDDUMP_LABEL")
oDump.HelpText = _GetLabel("DLGTRACE_CMDDUMP_HELP")
Set oTraceLog = oTraceDialog.Model.getByName("txtTraceLog")
oTraceLog.HelpText = _GetLabel("DLGTRACE_TXTTRACELOG_HELP")
If UBound(_A2B_.TraceLogs) >= 0 Then ' Array yet initialized
oTraceLog.HardLineBreaks = True
sText = ""
If _A2B_.TraceLogCount > 0 Then
If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
Do
If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
If Len(_A2B_.TraceLogs(i)) > 11 Then
sText = sText & Right(_A2B_.TraceLogs(i), Len(_A2B_.TraceLogs(i)) - 11) & sLineBreak ' Skip date in display
End If
Loop While i <> _A2B_.TraceLogLast
oDump.Enabled = 1 ' Enable DumpToFile only if there is something to dump
End If
If Len(sText) > 0 Then sText = Left(sText, Len(sText) - 1) ' Skip last linefeed
oTraceLog.Text = sText
Else
oTraceLog.Text = _GetLabel("DLGTRACE_TXTTRACELOG_TEXT")
End If
Set oClear = oTraceDialog.Model.getByName("chkClear")
oClear.State = 0 ' Unchecked
oClear.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
Set oControl = oTraceDialog.Model.getByName("lblClear")
oControl.Label = _GetLabel("DLGTRACE_LBLCLEAR_LABEL")
oControl.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
Set oMinLevel = oTraceDialog.Model.getByName("cboMinLevel")
If _A2B_.MinimalTraceLevel = 0 Then _A2B_.MinimalTraceLevel = _TraceLevel(TRACEERRORS)
oMinLevel.Text = _TraceLevel(_A2B_.MinimalTraceLevel)
oMinLevel.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
Set oControl = oTraceDialog.Model.getByName("lblMinLevel")
oControl.Label = _GetLabel("DLGTRACE_LBLMINLEVEL_LABEL")
oControl.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
Set oControl = oTraceDialog.Model.getByName("cmdOK")
oControl.Label = _GetLabel("DLGTRACE_CMDOK_LABEL")
oControl.HelpText = _GetLabel("DLGTRACE_CMDOK_HELP")
Set oControl = oTraceDialog.Model.getByName("cmdCancel")
oControl.Label = _GetLabel("DLGTRACE_CMDCANCEL_LABEL")
oControl.HelpText = _GetLabel("DLGTRACE_CMDCANCEL_HELP")
iOKCancel = oTraceDialog.Execute()
Select Case iOKCancel
Case 1 ' OK
If oClear.State = 1 Then
_A2B_.TraceLogs() = Array() ' Erase logged traces
_A2B_.TraceLogCount = 0
End If
If oMinLevel.Text <> "" Then _A2B_.MinimalTraceLevel = _TraceLevel(oMinLevel.Text)
If oEntries.Value <> 0 And oEntries.Value <> _A2B_.TraceLogMaxEntries Then
_A2B_.TraceLogs() = Array()
_A2B_.TraceLogMaxEntries = oEntries.Value
End If
Case 0 ' Cancel
Case Else
End Select
Exit_Sub:
If Not IsNull(oTraceDialog) Then oTraceDialog.Dispose()
Exit Sub
Error_Sub:
With _A2B_
.TraceLogs() = Array()
.TraceLogCount = 0
.TraceLogLast = 0
End With
GoTo Exit_Sub
End Sub ' TraceConsole V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub TraceError(ByVal psErrorLevel As String _
, ByVal piErrorCode As Integer _
, ByVal psErrorProc As String _
, ByVal piErrorLine As Integer _
, ByVal Optional pvMsgBox As Variant _
, ByVal Optional pvArgs As Variant _
)
' store error codes in trace buffer
On Local Error Resume Next
Dim sErrorText As String, sErrorDesc As String, oDb As Object
sErrorDesc = _ErrorMessage(piErrorCode, pvArgs)
sErrorText = _GetLabel("ERR#") & CStr(piErrorCode) _
& " (" & sErrorDesc & ") " & _GetLabel("ERROCCUR") _
& Iif(piErrorLine > 0, " " & _GetLabel("ERRLINE") & " " & CStr(piErrorLine), "") _
& Iif(psErrorProc <> "", " " & _GetLabel("ERRIN") & " " & psErrorProc, Iif(_A2B_.CalledSub = "", "", " " & _Getlabel("ERRIN") & " " & _A2B_.CalledSub))
If IsMissing(pvMsgBox) Then pvMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
TraceLog(psErrorLevel, sErrorText, pvMsgBox)
' Unexpected error detected in user program or in Access2Base
If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then
_A2B_.CalledSub = ""
If psErrorLevel = TRACEFATAL Then
Set oDb = Application.CurrentDb()
If Not IsNull(oDb) Then oDb.CloseAllrecordsets()
End If
Stop
End If
End Sub ' TraceError V0.9,5
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub TraceLevel(ByVal Optional psTraceLevel As String)
' Set trace level to argument
If _ErrorHandler() Then On Local Error Goto Error_Sub
Select Case True
Case IsMissing(psTraceLevel) : psTraceLevel = "ERROR"
Case psTraceLevel = "" : psTraceLevel = "ERROR"
Case Utils._InList(UCase(psTraceLevel), Array( _
TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT _
)
Case Else : Goto Exit_Sub
End Select
_A2B_.MinimalTraceLevel = _TraceLevel(psTraceLevel)
Exit_Sub:
Exit Sub
Error_Sub:
With _A2B_
.TraceLogs() = Array()
.TraceLogCount = 0
.TraceLogLast = 0
End With
GoTo Exit_Sub
End Sub ' TraceLevel V0.9.5
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub TraceLog(Byval psTraceLevel As String _
, ByVal psText As String _
, ByVal Optional pbMsgBox As Boolean _
)
' Store Text in trace log (circular buffer)
If _ErrorHandler() Then On Local Error Goto Error_Sub
Dim vTraceLogs() As String, sTraceLevel As String
With _A2B_
If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS)
If _TraceLevel(psTraceLevel) < .MinimalTraceLevel Then Exit Sub
If UBound(.TraceLogs) = -1 Then ' Initialize TraceLog
If .TraceLogMaxEntries = 0 Then .TraceLogMaxEntries = cstLogMaxEntries
Redim vTraceLogs(0 To .TraceLogMaxEntries - 1)
.TraceLogs = vTraceLogs
.TraceLogCount = 0
.TraceLogLast = -1
If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS) ' Set default value
End If
.TraceLogLast = .TraceLogLast + 1
If .TraceLogLast > UBound(.TraceLogs) Then .TraceLogLast = LBound(.TraceLogs) ' Circular buffer
If Len(psTraceLevel) > 7 Then sTraceLevel = Left(psTraceLevel, 7) Else sTraceLevel = psTraceLevel & Spc(8 - Len(psTraceLevel))
.TraceLogs(.TraceLogLast) = Format(Now(), "YYYY-MM-DD hh:mm:ss") & " " & sTraceLevel & psText
If .TraceLogCount <= UBound(.TraceLogs) Then .TraceLogCount = .TraceLogCount + 1 ' # of active entries
End With
If IsMissing(pbMsgBox) Then pbMsgBox = True
Dim iMsgBox As Integer
If pbMsgBox Then
Select Case psTraceLevel
Case TRACEINFO: iMsgBox = vbInformation
Case TRACEERRORS, TRACEWARNING: iMsgBox = vbExclamation
Case TRACEFATAL, TRACEABORT: iMsgBox = vbCritical
Case Else: iMsgBox = vbInformation
End Select
MsgBox psText, vbOKOnly + iMsgBox, psTraceLevel
End If
Exit_Sub:
Exit Sub
Error_Sub:
With _A2B_
.TraceLogs() = Array()
.TraceLogCount = 0
.TraceLogLast = 0
End With
GoTo Exit_Sub
End Sub ' TraceLog V0.9.5
REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub _DumpToFile(oEvent As Object)
' Execute the Dump To File command from the Trace dialog
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
If _ErrorHandler() Then On Local Error GoTo Error_Sub
Dim sPath as String, iFileNumber As Integer, i As Integer
sPath = _PromptFilePicker("txt")
If sPath <> "" Then ' Save button pressed
If UBound(_A2B_.TraceLogs) >= 0 Then ' Array yet initialized
iFileNumber = FreeFile()
Open sPath For Append Access Write Lock Read As iFileNumber
If _A2B_.TraceLogCount > 0 Then
If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
Do
If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
Print #iFileNumber _A2B_.TraceLogs(i)
Loop While i <> _A2B_.TraceLogLast
End If
Close iFileNumber
MsgBox _GetLabel("SAVECONSOLEENTRIES"), vbOK + vbInformation, _GetLabel("SAVECONSOLE")
End If
End If
Exit_Sub:
Exit Sub
Error_Sub:
TraceError("ERROR", Err, "DumpToFile", Erl)
GoTo Exit_Sub
End Sub ' DumpToFile V0.8.5
REM -----------------------------------------------------------------------------------------------------------------------
Public Function _ErrorHandler(Optional ByVal pbCheck As Boolean) As Boolean
' Indicate if error handler is activated or not
' When argument present set error handler
If Not IsMissing(pbCheck) Then _A2B_.ErrorHandler = pbCheck
_ErrorHandler = _A2B_.ErrorHandler
Exit Function
End Function
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _ErrorMessage(ByVal piErrorNumber As Integer, Optional ByVal pvArgs As Variant) As String
' Return error message corresponding to ErrorNumber (standard or not)
' and replaces %0, %1, ... , %9 by psArgs(0), psArgs(1), ...
Dim sErrorMessage As String, i As Integer, sErrLabel
_ErrorMessage = ""
If piErrorNumber > ERRINIT Then
sErrLabel = "ERR" & piErrorNumber
sErrorMessage = _Getlabel(sErrLabel)
If Not IsMissing(pvArgs) Then
If Not IsArray(pvArgs) Then
sErrorMessage = Join(Split(sErrorMessage, "%0"), Utils._CStr(pvArgs, False))
Else
For i = LBound(pvArgs) To UBound(pvArgs)
sErrorMessage = Join(Split(sErrorMessage, "%" & i), Utils._CStr(pvArgs(i), False))
Next i
End If
End If
Else
sErrorMessage = Error(piErrorNumber)
' Most (or all?) error messages terminate with a "."
If Len(sErrorMessage) > 1 And Right(sErrorMessage, 1) = "." Then sErrorMessage = Left(sErrorMessage, Len(sErrorMessage)-1)
End If
_ErrorMessage = sErrorMessage
Exit Function
End Function ' ErrorMessage V0.8.9
REM -----------------------------------------------------------------------------------------------------------------------
Public Function _PromptFilePicker(ByVal psSuffix As String) As String
' Prompt for output file name
' Return "" if Cancel
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oFileDialog as Object, oUcb as object, oPath As Object
Dim iAccept as Integer, sInitPath as String
Set oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oFileDialog.Initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION))
Set oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFileDialog.appendFilter("*." & psSuffix, "*." & psSuffix)
oFileDialog.appendFilter("*.*", "*.*")
oFileDialog.setCurrentFilter("*." & psSuffix)
Set oPath = createUnoService("com.sun.star.util.PathSettings")
sInitPath = oPath.Work ' Probably My Documents
If oUcb.Exists(sInitPath) Then oFileDialog.SetDisplayDirectory(sInitPath)
iAccept = oFileDialog.Execute()
_PromptFilePicker = ""
If iAccept = 1 Then ' Save button pressed
_PromptFilePicker = oFileDialog.Files(0)
End If
Exit_Function:
If Not IsEmpty(oFileDialog) And Not IsNull(oFileDialog) Then oFileDialog.Dispose()
Exit Function
Error_Function:
TraceError("ERROR", Err, "PromptFilePicker", Erl)
GoTo Exit_Function
End Function ' PromptFilePicker V0.8.5
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _TraceArguments(Optional psCall As String)
' Process the ERRMISSINGARGUMENTS error
' psCall is present if error detected before call to _SetCalledSub
If Not IsMissing(psCall) Then Utils._SetCalledSub(psCall)
TraceError(TRACEFATAL, ERRMISSINGARGUMENTS, Utils._CalledSub(), 0)
Exit Sub
End Sub ' TraceArguments
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _TraceLevel(ByVal pvTraceLevel As Variant) As Variant
' Convert string trace level to numeric value or the opposite
Dim vTraces As Variant, i As Integer
vTraces = Array(TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT, TRACEANY)
Select Case VarType(pvTraceLevel)
Case vbString
_TraceLevel = 4 ' 4 = Default
For i = 0 To UBound(vTraces)
If UCase(pvTraceLevel) = UCase(vTraces(i)) Then
_TraceLevel = i + 1
Exit For
End If
Next i
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
If pvTraceLevel < 1 Or pvTraceLevel > UBound(vTraces) + 1 Then _TraceLevel = TRACEERRORS Else _TraceLevel = vTraces(pvTraceLevel - 1)
End Select
End Function ' TraceLevel
</script:module>
|