延时程序偶然出现程序无响应现象

一个需要延时10s左右的函数，需要等待信号发送完毕之后返回到某函数处继续执行。该延时程序是这么写的。
Public Sub waitsend(PauseTime As Double)
    Dim StartTime As Single
    
    StartTime = GetTickCount
    Do While GetTickCount < StartTime + PauseTime
                
        DoEvents
       
        If StopTag = True Then Exit Sub
    
    Loop
End Sub

现在问题是：在偶然情况下，程序出现无响应现象，该现象出现1分钟左右回复正常，程序继续执行。
程序正常执行时，cpu占用率在40%左右，如果无响应现象出现，cpu占用率下降到4%左右。
从代码各种现象来看，现在怀疑问题出现在这个函数里面。

是不是在doevents的时候，OS干其他事情造成这个问题？

现在请问这种现象出现的原因是什么？用什么方法代替会比较好？

平台：操作系统，windows xp home版
      cpu，赛扬p4 1.8g
      内存,256M
      空闲内存，100M左右
已经停掉绝大部分无关服务。 --------------------编程问答-------------------- 是不是StartTime + PauseTime的问题，single＋double，精度不同之间的运算要留心一下，其他的基本没有什么问题～～ --------------------编程问答-------------------- 不一定是程序的问题,也有可能是病毒或其他问题产生的 --------------------编程问答-------------------- Public Sub waitsend(ByVal PauseTime As Long)
    
    Dim StartTime As Long
    
    StartTime = GetTickCount()
    
    Do While (StartTime + PauseTime > GetTickCount())
        
        Sleep 1
        DoEvents
        
        If StopTag = True Then Exit Do
    
    Loop

End Sub --------------------编程问答-------------------- 程序应该不是多线程的吧，sleep 只会导致发送不成功。
用 DoEvents 最容易出现的错误是消息重入，用 debug.print 调试一下，看是不是在这个处理未结束时又进来了

补充：VB ,  基础类