' 發展單位：風禹科技驗證有限公司
' 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水利博肄，微軟最有價值專家
' Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
' --------------------------------------------------------------------------------------

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Public Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Any, lpLocalFileTime As Any) As Long

' CPU Time
Private Declare Function GetSystemTimes Lib "kernel32" (lpIdleTime As Any, lpKernelTime As Any, lpUserTime As Any) As Long
Private Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As Any, lpExitTime As Any, lpKernelTime As Any, lpUserTime As Any) As Long
Private Declare Function GetThreadTimes Lib "kernel32" (ByVal hThread As Long, lpCreationTime As Any, lpExitTime As Any, lpKernelTime As Any, lpUserTime As Any) As Long

Public Enum enuCPUTimes
   VariantDate = 0
   
   CreationTime = 0
   ExitTime = 1
   KernelTime = 2
   UserTime = 3
   CPUTime = 4
   
   IdleTime = 1 ' CPU 閒置時間
   
   ' 輸出
   Ticks = &H10000
   Milliseconds = &H20000
   Seconds = &H40000
   Minutes = &H80000
   Hours = &H100000
   Days = &H200000
End Enum

Private Enum enuBaseTimes ' 以天為單位
   BaseZero = 0 ' 預設
   BaseFileTime = 109205 ' Abs(CDbl(#01-01-1601#))
   BaseNetDateTime = 693593 ' Net framework 1.1/2.0
End Enum

Public Function MyGetDateFromNetDateTime(ByVal dValue As Double, Optional ByVal srcFlags As enuCPUTimes = Ticks, Optional ByVal dstFlags As enuCPUTimes = VariantDate) As Variant
   ' 以毫秒為單位
   Select Case (srcFlags And &HFFFF0000)
   Case Ticks
      rtnTime = dValue / 10000
   Case Milliseconds
      rtnTime = dValue 
   Case Seconds
      rtnCPUTime = dValue * 1000
   Case Minutes
      rtnTime = dValue * 60000 ' 60 秒 * 1000 毫秒
   Case Hours
      rtnTime = dValue * 3600000 ' 60 分 * 60 秒 * 1000 毫秒
   Case Days
      rtnTime = dValue * 86400000 ' 24 小時 * 60 分 * 60 秒 * 1000 毫秒
   End Select
   
   MyGetDateFromNetDateTime = TransferDateTimes(rtnTime, nFlags, BaseNetDateTime)
End Function

Public Function MyGetSystemTimes(Optional ByVal nFlags As enuCPUTimes = IdleTime Or Seconds) As Variant
   Dim arrCPUTimes(UserTime) As Currency
   summy = GetSystemTimes(arrCPUTimes(IdleTime), arrCPUTimes(KernelTime), arrCPUTimes(UserTime))
   
   MyGetSystemTimes = TransferCPUTimes(arrCPUTimes, nFlags)
End Function

Public Function MyGetThreadTimes(Optional ByVal hThread As Long = -2, Optional ByVal nFlags As enuCPUTimes = CPUTime Or Seconds) As Variant
   Dim arrCPUTimes(UserTime) As Currency
   summy = GetThreadTimes(hThread, arrCPUTimes(CreationTime), arrCPUTimes(ExitTime), arrCPUTimes(KernelTime), arrCPUTimes(UserTime))
   
   MyGetThreadTimes = TransferCPUTimes(arrCPUTimes, nFlags)
End Function

Public Function MyGetProcessTimes(Optional ByVal hProcess As Long = -1, Optional ByVal nFlags As enuCPUTimes = CPUTime Or Seconds) As Variant
   Dim arrCPUTimes(UserTime) As Currency
   summy = GetProcessTimes(hProcess, arrCPUTimes(CreationTime), arrCPUTimes(ExitTime), arrCPUTimes(KernelTime), arrCPUTimes(UserTime))
   
   MyGetProcessTimes = TransferCPUTimes(arrCPUTimes, nFlags)
End Function

Private Function TransferDateTimes(ByVal srcMilliseconds As Double, ByVal dstFlags As enuCPUTimes, Optional ByVal nBaseFlags As enuBaseTimes = BaseZero) As Variant
   Select Case (dstFlags And &HFFFF0000)
   Case VariantDate
      rtnTime = CDate(srcMilliseconds / 86400000 - CDbl(nBaseFlags))
   Case Ticks
      rtnTime = srcMilliseconds * 10000
   Case Milliseconds
      rtnTime = srcMilliseconds
   Case Seconds
      rtnTime = srcMilliseconds / 1000
   Case Minutes
      rtnTime = srcMilliseconds / 60000 ' 60 秒 * 1000 毫秒
   Case Hours
      rtnTime = srcMilliseconds / 3600000 ' 60 分 * 60 秒 * 1000 毫秒
   Case Days
      rtnTime = srcMilliseconds / 86400000 ' 24 小時 * 60 分 * 60 秒 * 1000 毫秒
   End Select
   
   TransferDateTimes = rtnTime
End Function

Private Function TransferCPUTimes(arrCPUTimes() As Currency, ByVal nFlags As enuCPUTimes) As Variant
   Dim outCPUTime As Currency
   
   Select Case (nFlags And &HFFFF&)
   Case CreationTime
      FileTimeToLocalFileTime arrCPUTimes(nFlags And &HFFFF&), outCPUTime
      outCPUTime = outCPUTime - 9435312000000# ' ' 86400000 * 109205, Abs(CDbl(#01-01-1601#)) = 109205, Variant Date 的基準日
   Case CPUTime
      outCPUTime = arrCPUTimes(KernelTime) + arrCPUTimes(UserTime)
   Case Else
      outCPUTime = arrCPUTimes(nFlags And &HFFFF&)
   End Select
   
   rtnCPUTime = TransferDateTimes(CDbl(outCPUTime), nFlags, BaseZero)
   
   If rtnCPUTime < 0 Then
      If IsDate(rtnCPUTime) Then
         TransferCPUTimes = CDate(0)
      Else
         TransferCPUTimes = 0
      End If
   Else
      TransferCPUTimes = rtnCPUTime
   End If
End Function

Public Function MyWait(ByVal mySecond, Optional bDoEvents As Boolean = True, Optional ByVal dwMilliseconds As Long = 0)
' 精確計時, 無 DoEvents 時最小解析度小於 0.1 ms, 有 DoEvents 時最小解析度小於 10 ms, 最大有效時距大於 244,951 年
   Dim sf As Currency, tf As Currency
   Dim sc As Currency, nc As Currency
   
   QueryPerformanceFrequency sf
   tf = sf * mySecond
   
   QueryPerformanceCounter sc
   Do
      QueryPerformanceCounter nc
      If bDoEvents Then
         MyDoEvents dwMilliseconds
      End If
   Loop Until (nc - sc) > tf
   
   MyWait = (nc - sc) / sf
End Function

Public Function MyDoEvents(Optional ByVal dwMilliseconds As Long = 1)
   MyDoEvents = DoEvents()
   Sleep dwMilliseconds
End Function