Logging类编写
Function MyTest(ParamA, ParamB)
Dim OC
Set OC = Log.EnterFunction("MyTest",Array("ParamA", ParamA, "ParamB", ParamB))
'Function code
End Function
Function Repeat(sText, iCount)
Dim i
For i = 1 to iCount
Repeat = Repeat + sText
Next
End Function
'Class to define a function call
Class FunctionCall
'The name of the funtion
Dim FunctionName
'Array of parameters. Name and value pair
Dim Parameters
'Time of the call
Dim CallTime
Sub Class_Initialize()
CallTime = Now()
End Sub
Function GetCallDetails()
Dim s_Call, s_Params
'Check if parameter is an object
If IsObject(Parameters) Then
s_Params = "[object:"&TypeName(Parameters)&"]"
ElseIf not isArray(Parameters) Then
'If not an array convert it to a string
s_Params = CStr(Parameters)
Else
'We assume the parameters are key value pairs
'Make sure we have an even number of elements in array
If (UBound(Parameters) - LBound(Parameters) + 1) Mod 2 = 0 Then
Dim j
s_Param = ""
For j = LBound(Parameters) To UBound(Parameters) Step 2
s_Params = s_Params & Parameters(j) & ":="
'Check if the value of the parameter is a object
If IsObject(Parameters(j + 1)) Then
s_Params = s_Params & "[object:"&TypeName(Parameters(j + 1))&"] ,"
Else
s_Params = s_Params & GetArrayText(Parameters(j + 1)) & " ,"
End if
Next
Else
s_Params = "[Error key value pair not specified]"
End if
If Right(s_Params, 1) = "," Then
s_Params = Left(s_Params, Len(s_Params) - 1)
End if
End if
s_Call = FunctionName & " (" & s_Params & ")"
GetCallDetails = s_Call
End Function
Private Function GetArrayText(ByVal Arr)
On Error Resume Next
Err.Clear
If IsArray(Arr) Then
Dim newArr
newArr = Arr
Dim i
For i = LBound(newArr) to UBound(newArr)
if IsObject(newArr(i)) Then
newArr(i) = ""
Else
newArr(i) = CStr(newArr(i))
End if
Next
GetArrayText = "Array(""" & Join(newArr, """,""") & ")"
Else
GetArrayText = Arr
End if
If Err.Number Then
GetArrayText = ""
End if
End Function
End Class
'Function to get new instance of the function call
Function NewFunctionCall()
Set NewFunctionCall = New FunctionCall
End Function
'Class to get a callback executed. We need to set the two members
'Caller - The object which needs the callback
'CallbackCode - Code to be executed for callback
Class Callback
Public Caller
Public CallBackCode
Sub Class_Terminate()
Execute CallBackCode
End Sub
End Class
'Function get a new call object
Function NewCallback()
Set NewCallback = New Callback
End Function
Dim DEBUG_LOG
DEBUG_LOG = True
'Class logger allows logging function calls abd entering log text
'in between
Class Logger
'Dictionary to maintain curren stack trace
Private oStackTrace
Private sLog
'Class Initialization
Sub Class_Initializa()
Set oStackTrace = CreateObject("Scripting.Dictionary")
sLog = ""
End Sub
Function SaveDebugLog()
If DEBUG_LOG and sLog <> "" Then
Dim FSO, sFile, debugFile
Set FSO = CreateObject("Scripting.FileSystemObject")
sFile = "Debug_" & Replace(Replace(Now(), ":","_"), "/", "_", " ", "_") & ".txt"
Set debugFile = FSO.CreateTextFile(Reporter.ReportPath & "\Report\" & sFile, True)
debugFile.Write sLog
debugFile.Close
Set debugFile = Nothing
Set FSO = Nothing
sLog = ""
End if
End Function
'Class termination
Sub Class_Terminate()
SaveDebugLog
Set oStackTrace = Nothing
End Sub
'Private functions to Push and Pop Function calls
Private Function Push(oFunctionCall)
sLog = sLog + "[" & oFunctionCall.CallTime & "] " & Repeat(" | -", (oStackTrace.Count) * 2) & " Start Function - " & oFunctionCall.GetCallDetails & vbNewLine
Set oStackTrace(oStackTrace.Count + 1) = oFunctionCall
End Function
Sub Write(ByVal sText)
sLog = sLog & "[" & Now() & "] " & Repeat(" | -", (oStackTrace.Count)) & vbTab & sText & vbNewLine
End Sub
'Private function to pop and log the end of last function call
Private Sub Pop()
Dim oLastCall
'Get the details about last function call
Set oLastCall = oStackTrace(oStackTrace.Count)
'Remove the last function from the stack
oStackTrace.Remove oStackTrace.Count
'Append the end of funtion to log
sLog = sLog + "[" & oLastCall.CallTime & "] " & Repeat(" | -", (oStackTrace.Count) * 2) & " End Function - " & oLastCall.GetCallDetails & vbNewLine
Set oLastCall = Nothing
End Sub
'Function to pop the last function call
Sub LeaveFunction()
Call Pop
End Sub
'Method to be called when entering the funtion
'FunctionName - Name of the function being called
'Parameters - Array of key value pair
Function EnterFunction(FunctionName, Parameters)
'Create a new function call with given function name
'and parameters
Dim oFuncCall
Set oFuncCall = NewFunctionCall
oFuncCall.FunctionName = FunctionName
oFuncCall.Parameters = Parameters
'Push the function call on to the stack
Push oFuncCall
'Create a new callback
Set EnterFunction = New CallBack
'Set the caller as current object
Set EnterFunction.Caller = Me
'Set the callbackcode to execute leave function
EnterFunction.CallBackCode = "Caller.LeaveFunction"
End Function
Function Reporter()
Set Reporter = New CallBack
Set Reporter.Caller = Me
Report.CallBackCode = "Caller.SaveDebugLog"
End Function
Function GetLog()
GetLog = sLog
End Function
Function PrintLog()
Print "-----------------START LOG-------------------"
Print GetLog()
Print "-----------------End LOG-------------------"
End Function
'Function to get the current stack trace4
Function GetStackTrace()
Dim i
Dim s_TraceLog, s_CurrentFunction
s_TraceLog = ""
For i = 1 to oStackTrace.Count
s_TraceLog = s_TraceLog & "[" & oStackTrace(i).CallTime & "] -" & String((i - 1) * 2, "-")
s_TraceLog = s_TraceLog & oStackTrace(i).GetCallDetails() & vbNewLine
Next
GetStackTrace = s_TraceLog
End Function
'Function to print the stack trace
Sub PrintStackTrace()
Print "- START STACK TRACE -"
Print GetStackTrace()
Print "- END STACK TRACE -"
End Sub
End Class
Dim Log
Set Log = New Logger
