home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 22 / CD_ASCQ_22_0695.iso / win / prg / vbtrac20 / vbtrace.bas < prev    next >
BASIC Source File  |  1995-01-16  |  8KB  |  218 lines
  1.    Option Explicit
  2.    DefInt A-Z
  3.                
  4. '--FUNCTION TO SEE IF VBTRACE IS RUNNING
  5.    Declare Function CMS_FindWindow Lib "User" Alias "FindWindow" (ByVal ThunderForm As Any, ByVal lpCaption As Any)
  6.  
  7. '--INI FILES
  8.    Declare Function CMS_GetPrivateProfileString Lib "Kernel" Alias "GetPrivateProfileString" (ByVal Appname As String, ByVal KeyName As String, ByVal DEFAULT As String, ByVal ReturnedString As String, ByVal MaxSize, ByVal Filename As String)
  9.  
  10. '--GET FREE GDI AND USR MEMORY
  11.    Declare Function CMS_GetFreeSystemResources Lib "User" Alias "GetFreeSystemResources" (ByVal fuSysResource)
  12.    Global Const GDI = 1
  13.    Global Const USR = 2
  14.  
  15. '--GET SYSTEM MEMORY
  16.    Declare Function CMS_GetFreeSpace Lib "Kernel" Alias "GetFreeSpace" (ByVal wFlags) As Long
  17.  
  18. '--FREE DISK SPACE
  19.    Declare Function CMS_DiskSpaceFree Lib "SetupKit.DLL" Alias "DiskSpaceFree" () As Long
  20.    
  21.  
  22. Sub VBTrace (OpCode, ProcedureName As String)
  23.  
  24. '--DECLARE VARIABLES
  25.    Dim I, J
  26.    Dim Result
  27.    Dim ThisTime As Double
  28.    Dim OutRecord As String
  29.    Dim TraceGridVariable As String
  30.    Dim ElapsedTime As String
  31.    Dim CumlativeTime As String
  32.    Dim TotalTime As String
  33.    Dim Percent As String
  34.    Dim Msg As String
  35.    Dim SyncCode As String
  36.    Dim ppFileName As String
  37.    Dim ppValue As String
  38.  
  39. '--DECLARE CONSTANTS
  40.    Const IconStop = 16
  41.    Const ThisProgramsSyncCode = ""
  42.    Const TraceFileRecordLength = 600
  43.    Const ppTitle = "VBTrace Grid Column Configuration"
  44.    Const ppItem = "SyncCode"
  45.    Const ppDefault = ""
  46.    Const Padder = "."
  47.  
  48. '--DECLARE STATIC VARIABLES
  49.    Static TraceOperationOffSwitch
  50.    Static PreviousLine()
  51.    Static PreviousTime() As Double
  52.    Static CumTime() As Double
  53.    Static PercentTime()
  54.    Static TotalRunTime As Double
  55.    Static EntryCount()
  56.    Static ExitCount()
  57.    Static LineNumber
  58.    Static ProcedureNames() As String
  59.    Static PreviousProcedure As String
  60.    Static PreviousOpCode
  61.    Static MarginWidth
  62.    Static VBTraceFileNo
  63.    
  64. '--IF TRACE HAS BEEN TURNED OFF THEN EXIT
  65.    If TraceOperationOffSwitch Then
  66.       Exit Sub
  67.    ElseIf CMS_FindWindow(0&, "VBTrace 2.0  -  Visual Basic Debug Utility") Then
  68.    ElseIf CMS_FindWindow(0&, "VBTrace") Then
  69.    Else
  70.       Exit Sub
  71.    End If
  72.  
  73. '--GET ARBAY SIZE AND BUMP IF NECESSARY
  74.    ReDim EntryExit(1) As String
  75.    EntryExit(0) = "(Entry)"
  76.    EntryExit(1) = "(Exit)"
  77.    On Error Resume Next
  78.    For I = 0 To UBound(ProcedureNames)
  79.       If ProcedureName = ProcedureNames(I) Then
  80.          Exit For
  81.       End If
  82.    Next I
  83.    If I > UBound(ProcedureNames) Then
  84.       ReDim Preserve ProcedureNames(I + 100)
  85.       ReDim Preserve CumTime(I + 100)
  86.       ReDim Preserve PercentTime(I + 100)
  87.       ReDim Preserve EntryCount(I + 100)
  88.       ReDim Preserve ExitCount(I + 100)
  89.       ReDim Preserve PreviousLine(-1 To I + 100)
  90.       ReDim Preserve PreviousTime(-1 To I + 100)
  91.       ProcedureNames(I) = ProcedureName
  92.    End If
  93.    
  94. '--SET INDENT
  95.    Select Case OpCode
  96.       Case 1         'ENTERED PROCEDURE
  97.          EntryCount(I) = EntryCount(I) + 1
  98.          If PreviousOpCode = 1 Then
  99.             MarginWidth = MarginWidth + 2
  100.          End If
  101.       Case 2         'EXITED PROCEDURE
  102.          ExitCount(I) = ExitCount(I) + 1
  103.          If ProcedureName <> PreviousProcedure Then
  104.             MarginWidth = MarginWidth - 2
  105.          End If
  106.    End Select
  107.          
  108. '--GET SYNCCODE IF FIRST LINE
  109.    ppValue = Space$(199)
  110.    Result = CMS_GetPrivateProfileString(ppTitle, ppItem, ppDefault, ppValue, Len(ppValue) + 1, app.Path & "\VBTRACE.INI")
  111.    SyncCode = Trim$(ppValue)
  112.    If SyncCode <> ThisProgramsSyncCode & Chr$(0) Then
  113.       Msg = "The VBTrace Column Configuration Has Changed Since This Program "
  114.       Msg = Msg & "Was Loaded.  You Must Exit And Reload This Program."
  115.       MsgBox Msg, IconStop, "VBTrace Error Message"
  116.       Close
  117.       End
  118.    End If
  119.    If LineNumber = 0 Or Len(Dir$(app.Path & "\VBTRACE.TXT")) = False Then
  120.       If Len(Dir$(app.Path & "\VBTRACE.TXT")) Then
  121.          Kill app.Path & "\VBTRACE.TXT"
  122.       End If
  123.       OutRecord = "/*" & Now & ","
  124.       ReDim ProcedureNames(0)
  125.       I = False
  126.       LineNumber = False
  127.    End If
  128.    LineNumber = LineNumber + 1
  129.    
  130. '--GET ELASPSED TIME
  131.    ThisTime = Timer
  132.    If PreviousTime(I) Then
  133.       If OpCode = 2 Then
  134.          ElapsedTime = Str$(ThisTime - PreviousTime(I))
  135.          CumTime(I) = CumTime(I) + Val(ElapsedTime)
  136.          CumlativeTime = Format$(CumTime(I), "##0.0")
  137.          TotalRunTime = TotalRunTime + Val(ElapsedTime)
  138.          TotalTime = Format$(TotalRunTime, "##0.0")
  139.          PercentTime(I) = CumTime(I) / TotalRunTime * 100
  140.          Percent = Format$(PercentTime(I))
  141.       End If
  142.    End If
  143.    
  144. '--ASSEMBLE COLUMN DATA
  145.    TraceGridVariable = "LineNumber"
  146.    OutRecord = OutRecord & "LineNumber," & LineNumber & ","
  147.    TraceGridVariable = "PreviousLine(I)"
  148.    OutRecord = OutRecord & "PreviousLine(I)," & PreviousLine(I) & ","
  149.    TraceGridVariable = "ElapsedTime"
  150.    OutRecord = OutRecord & "ElapsedTime," & ElapsedTime & ","
  151.    TraceGridVariable = "CumlativeTime"
  152.    OutRecord = OutRecord & "CumlativeTime," & CumlativeTime & ","
  153.    TraceGridVariable = "Percent"
  154.    OutRecord = OutRecord & "Percent," & Percent & ","
  155.    TraceGridVariable = "TotalTime"
  156.    OutRecord = OutRecord & "TotalTime," & TotalTime & ","
  157.    TraceGridVariable = "EntryCount(I)"
  158.    OutRecord = OutRecord & "EntryCount(I)," & EntryCount(I) & ","
  159.    TraceGridVariable = "ExitCount(I)"
  160.    OutRecord = OutRecord & "ExitCount(I)," & ExitCount(I) & ","
  161.    TraceGridVariable = "ProcedureName"
  162.    OutRecord = OutRecord & "ProcedureName," & ProcedureName & ","
  163.    OutRecord = OutRecord & "\,\,"
  164.    
  165. '--APPEND MEMORY VALUES TO RECORD
  166.    TraceGridVariable = "Available GDI Memory"
  167.    OutRecord = OutRecord & Format$(CMS_GetFreeSystemResources(GDI)) & ","
  168.    TraceGridVariable = "Available USER Memory"
  169.    OutRecord = OutRecord & Format$(CMS_GetFreeSystemResources(USR)) & ","
  170.    TraceGridVariable = "Available Global Heap Memory"
  171.    OutRecord = OutRecord & Format$(CMS_GetFreeSpace(0)) & ","
  172.       
  173. '--APPEND DISK SPACE TO RECORD
  174.    TraceGridVariable = "Available Disk Space"
  175.    OutRecord = OutRecord & Left$(app.Path, 1) & Format$(CMS_DiskSpaceFree()) & ","
  176.    
  177. '--APPEND FORMS COUNT TO RECORD
  178.    TraceGridVariable = "Forms Count"
  179.    OutRecord = OutRecord & Forms.Count & ","
  180.    
  181. '--APPEND PROCEDURE NAME TO RECORD
  182.    TraceGridVariable = ProcedureName
  183.    OutRecord = OutRecord & String$(MarginWidth, Padder) & ProcedureName & EntryExit(OpCode - 1)
  184.    TraceGridVariable = ""
  185.    
  186. '--APPEND PASSED VARIABLES TO RECORD
  187.  
  188. '--OPEN TRACE FILE, WRITE RECORD, AND CLOSE FILE
  189.    VBTraceFileNo = FreeFile
  190.    Open app.Path & "\VBTRACE.TXT" For Random Shared As VBTraceFileNo Len = TraceFileRecordLength
  191.       OutRecord = Left$(OutRecord & Space$(TraceFileRecordLength - 2), TraceFileRecordLength - 2)
  192.       Put #VBTraceFileNo, LineNumber, OutRecord
  193.       PreviousLine(I) = LineNumber
  194.       PreviousTime(I) = ThisTime
  195.       PreviousOpCode = OpCode
  196.       PreviousProcedure = ProcedureName
  197.   Close VBTraceFileNo
  198. Exit Sub
  199.    
  200. VBTraceError:
  201.    If Len(TraceGridVariable) Then
  202.       Msg = Error$ & " Referencing TraceGrid Variable '" & TraceGridVariable & "'.  "
  203.       Msg = Msg & "Disabling VBTrace."
  204.    End If
  205.    If Len(Msg) = 0 Then
  206.       Msg = Error$
  207.    End If
  208.    MsgBox Msg, IconStop, "VBTrace Error Handler"
  209.    Msg = ""
  210.    TraceOperationOffSwitch = True
  211.    Close VBTraceFileNo
  212.    If Len(Dir$(app.Path & "\VBTRACE.TXT")) Then
  213.       Close VBTraceFileNo
  214.       Kill app.Path & "\VBTRACE.TXT"
  215.    End If
  216. End Sub
  217.  
  218.