home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / classlib / desaware / dwbench.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  4.0 KB  |  126 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwBenchMark"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. ' dwBenchMark - Benchmarking utility class
  9. ' Part of the Desaware API Class Library
  10. ' Copyright (c) 1996 by Desaware Inc.
  11. ' All Rights Reserved
  12.  
  13. Option Explicit
  14.  
  15. #If Win32 Then
  16.  
  17. Private Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
  18. Attribute GetProcessTimes.VB_HelpID = 2139
  19. Attribute GetProcessTimes.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  20. Private Declare Function GetTickCount Lib "kernel32" () As Long
  21. Attribute GetTickCount.VB_HelpID = 2356
  22. Attribute GetTickCount.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  23. Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  24. Attribute GetCurrentProcess.VB_HelpID = 2141
  25. Attribute GetCurrentProcess.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  26.  
  27. Private Type FILETIME
  28.         dwLowDateTime As Long
  29.         dwHighDateTime As Long
  30. End Type
  31.  
  32. ' This is the reference user time as marked.
  33. Private ReferenceTime As FILETIME
  34. ' This is the marked user time for comparisons.
  35. Private MarkTime As FILETIME
  36.  
  37. ' This is the reference kernel time as marked.
  38. Private ReferenceKTime As FILETIME
  39. ' This is the marked kernel time for comparisons.
  40. Private MarkKTime As FILETIME
  41.  
  42. ' Reference TickCount
  43. Private ReferenceTick As Long
  44. ' The marked tick count for comparisons
  45. Private MarkTick As Long
  46.  
  47. ' A variable to hold the current process handle to use
  48. Private ThisProcess As Long
  49.  
  50. ' Dummy filetime structures that we won't actually use
  51. Private fcreate As FILETIME
  52. Private fexit As FILETIME
  53.  
  54. Private Sub Class_Initialize()
  55.     ' There is no need to close this pseudo handle
  56.     ThisProcess = GetCurrentProcess()
  57. End Sub
  58.  
  59. ' Sets the reference time
  60. Public Sub SetReference()
  61.     ReferenceTick = GetTickCount
  62.     Call GetProcessTimes(ThisProcess, fcreate, fexit, ReferenceKTime, ReferenceTime)
  63. End Sub
  64.  
  65.  
  66. ' Sets the mark time
  67. Public Sub SetMark()
  68.     MarkTick = GetTickCount
  69.     Call GetProcessTimes(ThisProcess, fcreate, fexit, MarkKTime, MarkTime)
  70. End Sub
  71.  
  72. ' Subtracts MarkTime from ReferenceTime and returns the difference
  73. Private Function CalculateDifference(ByVal timespec As Integer) As FILETIME
  74.     Dim f As FILETIME
  75.     Select Case timespec
  76.         Case 0  ' User time
  77.                 Call agSubtractFileTimes(MarkTime, ReferenceTime, f)
  78.         Case 1  ' Kernel time
  79.                 Call agSubtractFileTimes(MarkKTime, ReferenceKTime, f)
  80.     End Select
  81.     CalculateDifference = f
  82. End Function
  83.  
  84. ' Debug routine
  85. #If DEBUGCOMPILE Then
  86. Public Sub dbg1()
  87.     Dim f As FILETIME
  88.     f = CalculateDifference()
  89.     Debug.Print Hex$(f.dwHighDateTime) & " " & Hex$(f.dwLowDateTime)
  90.     
  91. End Sub
  92. #End If
  93.  
  94.  
  95. ' Get the difference based on the tick count in ms
  96. Public Function GetTickDifference() As Long
  97.     GetTickDifference = MarkTick - ReferenceTick
  98. End Function
  99.  
  100. ' Get the difference based on user time in ms
  101. Public Function GetuserDifferenceMS() As Double
  102.     Dim diff As FILETIME
  103.     Dim res As Double
  104.     diff = CalculateDifference(0)
  105.     res = diff.dwLowDateTime / 10000
  106.     If diff.dwHighDateTime <> 0 Then
  107.         ' Add in the number of milliseconds for each high count
  108.         res = res + diff.dwHighDateTime * 42949.67296
  109.     End If
  110.     GetuserDifferenceMS = res
  111. End Function
  112.  
  113. Public Function GetkernelDifferenceMS() As Double
  114.     Dim diff As FILETIME
  115.     Dim res As Double
  116.     diff = CalculateDifference(1)
  117.     res = diff.dwLowDateTime / 10000
  118.     If diff.dwHighDateTime <> 0 Then
  119.         ' Add in the number of milliseconds for each high count
  120.         res = res + diff.dwHighDateTime * 42949.67296
  121.     End If
  122.     GetkernelDifferenceMS = res
  123. End Function
  124.  
  125. #End If ' This class exists in win32 only
  126.