97 lines
2.3 KiB
OpenEdge ABL
97 lines
2.3 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "API_Logger"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
' ================ Log functionality =============
|
|
' Shared module version: 20210413
|
|
' Tested in: TestCommons
|
|
' Depends on: ex_VBA
|
|
' Required reference: Scripting
|
|
' Note: log is saved as UTF-16 encoded text file
|
|
Option Explicit
|
|
|
|
Private fileName_ As String
|
|
|
|
Public Function Init(sName$)
|
|
If sName = vbNullString Then _
|
|
Exit Function
|
|
fileName_ = sName
|
|
Call EnsureOutputExists
|
|
End Function
|
|
|
|
Public Property Get LogFileName() As String
|
|
LogFileName = fileName_
|
|
End Property
|
|
|
|
Public Function Log(sMsg$)
|
|
If fileName_ <> vbNullString Then
|
|
Call LogIntoFile(StampTime(sMsg))
|
|
Else
|
|
Call LogDefault(StampTime(sMsg))
|
|
End If
|
|
End Function
|
|
|
|
Public Function Report(sMsg$, Optional nFlags& = 0)
|
|
' TODO: indicate flags
|
|
Call Log(sMsg)
|
|
End Function
|
|
|
|
Public Function Clear()
|
|
If fileName_ <> vbNullString Then _
|
|
Call CreateLogFile
|
|
End Function
|
|
|
|
' ==========
|
|
Private Function LogIntoFile(sMsg$)
|
|
Const UTF16_MODE = TristateTrue
|
|
|
|
Dim fso As New Scripting.FileSystemObject
|
|
If Not fso.FileExists(fileName_) Then _
|
|
GoTo CANNOT_ACCESS
|
|
|
|
Dim fs As Scripting.TextStream: Set fs = fso.OpenTextFile(fileName_, ForAppending, Format:=UTF16_MODE)
|
|
If fs Is Nothing Then _
|
|
GoTo CANNOT_ACCESS
|
|
|
|
Call fs.WriteLine(sMsg)
|
|
Call fs.Close
|
|
Exit Function
|
|
|
|
CANNOT_ACCESS:
|
|
Call LogDefault(StampTime("Cannot access log"))
|
|
Call LogDefault(sMsg)
|
|
End Function
|
|
|
|
Private Function LogDefault(sMsg$)
|
|
Debug.Print sMsg
|
|
End Function
|
|
|
|
Private Function EnsureOutputExists()
|
|
Dim fso As New Scripting.FileSystemObject
|
|
If fso.FileExists(fileName_) Then _
|
|
Exit Function
|
|
|
|
Call CreateLogFile
|
|
End Function
|
|
|
|
Private Function StampTime(sMsg$) As String
|
|
StampTime = Format(Now(), "yyyy-mm-dd hh:mm:ss") & ": " & sMsg
|
|
End Function
|
|
|
|
Private Function CreateLogFile()
|
|
Dim fso As New Scripting.FileSystemObject
|
|
Call EnsureFolderExists(fso.GetParentFolderName(fileName_))
|
|
Dim fs As Scripting.TextStream: Set fs = fso.CreateTextFile(fileName_, Unicode:=True)
|
|
If fs Is Nothing Then
|
|
Call LogDefault(StampTime("Cannot create log: " & fileName_))
|
|
Else
|
|
Call fs.Close
|
|
Call Log("Log file created")
|
|
End If
|
|
End Function
|