一个人家的实现延时功能的代码,看不懂.高手帮看看,谢谢!

Question

找来的一个人家的实现延时功能的代码,看不懂.高手帮看看,谢谢!
--------------------
Private Function delay() '想用时就调用这个过程
Dim n
n = 600'1分钟*10=10分钟
Dim tm1 As Long, tm2 As Long
tm1 = timeGetTime
Do
tm2 = timeGetTime
If (tm2 - tm1) / 1000 > n Then Exit Do
DoEvents
Loop
End Function
----------------------
1.tm1和tm2,为什么两个一摸一样的赋值相减就可以延时呢?两个都是程序启动开始计时得到值得吧?
2.如果我想我其它的代码在程序启动(Formload)后10分钟再执行,在formload里调用这个函数,其它代码放在这个延时函数的后面就可以吧?
多谢了!

Answer 1

Public Declare Function timeGetTime Lib "winmm.dll" Alias "timeGetTime" () As Long　　timeGetTime：函数以毫秒计的系统时间。该时间为从系统开启算起所经过的时间。 　　
DWORD timeGetTime(VOID); 　　
参数：无参数。 　　
返回值：以毫秒值返回系统时间。 　　
备注：该函数与timeGetSystemTime函数的唯一不同是timeGetSystemTime函数使用MMTIME结构返回系统时间。TimeGetSystemTime比timeGetTime需要更多的系统开销。注意timeGetTime函数是一个双字。这个值在0到2^32之间。大约49.71天。如果在代码中直接将该值用于计算，会导致一些问题，特别是用该值来控制代码的执行。一般利用两个timeGetTime函数返回值的不同来用于计算。 　　Windows NT：该函数的时间精度是五毫秒或更大一些，这取决于机器的性能。可用timeBeginPeriod和timeEndPeriod函数提高timeGetTime函数的精度。如果使用了，连续调用timeGetTime函数，一系列返回值的差异由timeBeginPeriod和timeEndPeriod决定。QueryPerformanceCounter QueryPerformanceFrequency函数用于分辨率要求更高的时间测量。 　　
Windows95 默认分辨率是1毫秒，无论是否调用timeBeginPeriod和timeEndPeriod函数。 

Answer 2

因为timeGetTime是个函数,用来获得开机至现在的运行时间,单位毫秒.
等于就是一直看时间,看啊看啊,看到时间到了就跳出循环

Answer 3

用这个破代码延迟10分钟，用户要剁了你了。什么都不做，白白浪费 100% 的 CPU。

Answer 4

+++
有一种延时不怎么占CPU的，楼主搜搜看

Answer 5

其实在 DoEvents 后面插入一条 Sleep 100 就会好很多。
注意声明下 Sleep 函数。

Answer 6

经过测试，这个延时的CPU占用比较少，似乎只有2％…
由于也是从某个回复上复制过来的代码，所以其版权属于原作者，本人也无法给你描述版权，见谅。
要测试此代码，新建一个工程，一个command1用来实现延时，一个text1用来说明延时长度，都取默认名。Option Explicit'2009-10-15
'延时模块(不会让窗口失去响应，不太占CPU)
'调用方式：Yanshi(300)，即延时300毫秒。
'本模块参考了某个类模块，那个类模块里的代码我理解得不透彻，就精简了一下写了本模块，没想到
'也能用，暂时没发现问题。
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim i As Long
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePrivate Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal Htimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As LongPrivate Const WAIT_OBJECT_0 = 0
Private Const INFINITE = &HFFFF    '无限超时(Infinite timeout)
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE Or QS_PAINT Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY)Private Sub Command1_Click()
    i = GetTickCount
    Yanshi (Val(Text1.Text))
    Me.Caption = "已经延时：" & GetTickCount - i & " ms"
End SubPublic Sub Yanshi(MilliSeconds As Long)
    On Error GoTo Cuo:
Dim Htimer As Long, WenjianTime As FILETIME, Ret As Long
    'Htimer是计时器句柄    If Htimer <> 0 Then CloseHandle Htimer
    Htimer = CreateWaitableTimer(0, True, "Timer" & Format(Now, "hhmmnn"))
    'CreateWaitableTimer创建一个可等待的计时器对象，返回值：Long，如执行成功，返回可等待
    '计时器对象的句柄；零表示出错。参数lpSemaphoreAttributes As SECURITY_ATTRIBUTES
    '指定一个结构，用于设置对象的安全特性。如将参数声明为ByVal As Long，并传递零值，
    '就可使用对象的默认安全设置。bManualReset As Long，如果为TRUE，表示创建一个人工重设计时器；
    '如果为FALSE，则创建一个自动重设计时器。lpName As String，指定可等待计时器对象的名称。
    If Htimer = 0 Then
        Debug.Print "调用CreateWaitableTimer失败"
        Exit Sub
    End If
    WenjianTime.dwHighDateTime = -1
    WenjianTime.dwLowDateTime = -(MilliSeconds * 10000)
    Ret = SetWaitableTimer(Htimer, WenjianTime, 0, 0, 0, 0)
    'SetWaitableTimer启动一个可等待计时器，将它设为未发信号状态。返回值 As Long，非零表示成功，
    '零表示失败。hTimer As Long，指定一个可等待计时器的句柄。lpDueTime As FILETIME，指定
    '一个包含了64位时间值的结构。如果为正，它代表计时器要触发的时间。如果为负，它代表自
    '函数调用以来持续的时间。时间是以100ns为单位指定的。lPeriod As Long，如果为零，这个计时器
    '只会触发一次。否则，计时器会根据这里设置的持续时间自动重新启动(以毫秒为单位指定)。
    'pfnCompletionRoutine As Long，指定零或者计时器触发时要调用的一个函数的地址。可在标准
    '模块中用一个函数通过AddressOf操作符提供这个地址。或者使用此类ocx控件。最终的例程采取下述形式：
    'Sub myfunc(ByVal lpArgToCompletion&, ByVal dwTimerLow&, ByVal dwTimerHigh&)
    'lpArgToCompletionRoutine As Long，传递给最终例程的值。fResume As Long，如果为TRUE，
    '而且系统支持电源管理，那么在计时器触发的时候，系统会退出省电模式。如设为TRUE，但系统不
    '支持省电模式，GetLastError就会返回ERROR_NOT_SUPPORTED。
    '至于WenjianTime的dwHighDateTime和dwLowDateTime，dwHighDateTime设为-1，
    'dwLowDateTime设为-(延时时间*10000)，因为要转换单位，所以要*10000。至于为什么是负的，
    '请看此句：如果为正，它代表计时器要触发的时间。如果为负，它代表自函数调用以来持续的时间。
    '时间是以100ns为单位指定的。后面4个参数都填0。
    If Ret = 0 Then
        Debug.Print "调用SetWaitableTimer失败"
        CloseHandle Htimer
        Exit Sub
    End If
    Do
        Ret = MsgWaitForMultipleObjects(1, Htimer, False, INFINITE, QS_ALLINPUT)
        '等候计时器发出信号
        DoEvents
    Loop Until Ret = WAIT_OBJECT_0
    'MsgWaitForMultipleObjects等候单个对象或一系列对象发出信号，标志着规定的超时已经过去，
    '或特定类型的消息已抵达线程的输入队列。如返回条件已经满足，则立即返回。返回WAIT_OBJECT_0
    '意思是所有的对象都发出信号。参数：nCount，指定列表中的句柄数量。pHandles，指定对象句柄
    '组合中的第一个元素。fWaitAll，如果为TRUE，表示除非对象同时发出信号，否则就等待下去。
    '如果为FALSE，表示任何对象发出信号即可。dwMilliseconds，指定要等待的毫秒数，填INFINITE
    '表示无限等待。dwWakeMask，带有QS_??前缀的一个或多个常数，用于标识特定的消息类型。
    '如果用WaitForSingleObject函数就会导致窗口失去响应，所以本例用MsgWaitForMultipleObjects函数。
    '一旦不再需要，一定记住用CloseHandle关闭计时器对象的句柄。它的所有句柄都关闭以后，
    '对象自己也会删除。
    CloseHandle Htimer
    Htimer = 0    Exit Sub
Cuo:
    CloseHandle HtimerEnd Sub

Answer 7

Private Function delay()
Dim after As Double
    after = Now + 600# / 24# / 3600# '600秒
    Do
        DoEvents
        If Now > after Then
            Exit Do
        End If
    Loop
End Function

Answer 8

Option Explicit
'**************************************
' Name:        clsWaitableTimer
'
' Description: This class encapsulate the WaitableTimer API functions to
'              put the thread of your application to Sleep for a period of time.
'              The benefit of a Waitable timer to the Sleep API is that your
'              application will still be responsive to events, where Sleep
'              will freeze your application for the set interval.
'
' Example:     'This is an example for idling your application
'              Private mobjWaitTimer As clsWaitableTimer
'              Private Sub RunProcess()
'                Set mobjWaitTimer = New clsWaitableTimer
'                Do
'                 If mbWorkToDo Then
'                   Call ProcessWork()
'                 Else
'                   mobjWaitTimer.Wait(5000) 'Wait for 5 seconds
'                 End If
'                Loop Until Not mbStop
'                Set mobjWaitTimer = nothing
'              End Sub
'
' Revision History:Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePrivate Const WAIT_ABANDONED& = &H80&
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_FAILED& = -1&
Private Const WAIT_IO_COMPLETION& = &HC0&
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_OBJECT_1& = 1
Private Const WAIT_TIMEOUT& = &H102&
Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE Or QS_PAINT Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY)Private Const UNITS = 4294967296#
Private Const MAX_LONG = -2147483648#Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
Private Declare Function OpenWaitableTimer Lib "kernel32" Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal hTimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
Private Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As LongPrivate mlTimer As LongPrivate Sub Class_Terminate()
    On Error Resume Next
    If mlTimer <> 0 Then CloseHandle mlTimer
End SubPublic Sub Wait(MilliSeconds As Long)
    On Error GoTo ErrHandler
    Dim ft As FILETIME
    Dim lBusy As Long
    Dim lRet As Long
    Dim dblDelay As Double
    Dim dblDelayLow As Double
    
    mlTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer" & Format$(Now(), "NNSS"))
    
    If Err.LastDllError <> ERROR_ALREADY_EXISTS Then
        ft.dwLowDateTime = -1
        ft.dwHighDateTime = -1
        lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, 0)
    End If
    
    ' Convert the Units to nanoseconds.
    dblDelay = CDbl(MilliSeconds) * 10000#
    
    ' By setting the high/low time to a negative number, it tells
    ' the Wait (in SetWaitableTimer) to use an offset time as
    ' opposed to a hardcoded time. If it were positive, it would
    ' try to convert the value to GMT.
    ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1
    dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS)))
    
    If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow
    
    ft.dwLowDateTime = CLng(dblDelayLow)
    lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, False)
    
    Do
        ' QS_ALLINPUT means that MsgWaitForMultipleObjects will
        ' return every time the thread in which it is running gets
        ' a message. If you wanted to handle messages in here you could,
        ' but by calling Doevents you are letting DefWindowProc
        ' do its normal windows message handling---Like DDE, etc.
        lBusy = MsgWaitForMultipleObjects(1, mlTimer, False, INFINITE, QS_ALLINPUT&)
        DoEvents
    Loop Until lBusy = WAIT_OBJECT_0
    
    ' Close the handles when you are done with them.
    CloseHandle mlTimer
    mlTimer = 0
    Exit Sub
    
ErrHandler:
    Err.Raise Err.Number, Err.Source, "[clsWaitableTimer.Wait]" & Err.Description
End Sub'form
 Private mobjWaitTimer As clsWaitableTimer
 
Private Sub Command1_Click()
  Set mobjWaitTimer = New clsWaitableTimer
  mobjWaitTimer.Wait (5000)
  MsgBox 1
  Set mobjWaitTimer = Nothing
End SubPrivate Sub Command2_Click()
 MsgBox 2
End Sub这个延时不影响别的地方的使用

Answer 9

难道你们都不用timer这个控件？我表示无语

Answer 10

楼上的类经过测试效果最好，CPU占用很低，几乎察觉不到。

Answer 11

谢谢!!昨天是不是CSDN出问题了?我发帖子的时候就老是显示"没有响应",好不容易发成功的,昨天回来看了几次都没有一个回复,今天来一看这么多回复,谢谢!!!再请教下大侠们:timeGetTime函数是API函数,应该不管什么机器上都可以运行的吧?我程序在自己机器上用是好的,后来拿到别的一个机器上用,报错"ActiveX component can't create object ",跟这个没关系吧?
但是我程序里面也没别的代码了,只有个用cdo发邮件的过程,但是那个机器(O.E.是有的)以前我试了cdo发邮件是可以的.搞不懂了.延时实现的问题:
1.sleep据说不是很好,会类似死机,而且不稳定.
2.有函数或者过程调用最好了,可以多个地方调用.用timer控件的话要另外弄,打破程序.
3.占用CPU问题我后来看到别人说用下waitmessage就不会占CPU,试了下貌似是的.谢谢楼上大侠们的代码,我去试下.谢谢!!

Answer 12

sleep据说不是很好,会类似死机,而且不稳定.错。Sleep 会挂起线程，在挂起的时候的确无法响应用户输入。但是 Sleep < 100ms 几乎感觉不到。
不稳定是无稽之谈。事实上线程挂起是非常普遍的操作，几乎所有程序都会被 OS 挂起，要是造成不稳定，Windows 系统可以报废了。

Answer 13

你也知道是“控件”，如果在没有窗口的类中使用，你也用“控件”？
----------------------------------------------------------------
用 sleep 的确会节约 CPU 的开销，因为他是让线程暂停的函数。
既然线程每隔一小段时间就暂停一次，自然就会有时间处理别的东西，当然不会占用很大的 CPU 资源。
但是，因为 VB 程序一启动就只有一个线程，如果主线程被暂停了，肯定会有卡的现象，如果这个过程
用多线程来做，暂停的不是主线程，而是新开的子线程，就不会有卡的现象，但是要把VB的多线程玩到
稳定，是需要花些功夫的。