如何防止程序一执行就占用 cpu 99%然后就死掉?

Question

循环过程,非常容易一下子就占CPU  99%或稍低,把程序弄死.有什么办法防止? vb程序或windows怎么这么不智能呢?应该自动适应自动调整分配下慢慢来么,别一上来就把cpu整死.

Answer 1

如果大的循环，比如要执行若干秒的时候，可以采取以下措施：
1，给用户一个提示，表示正在忙，无法响应用户
2，在循环体中的合适位置 加入 doevents
3，调整算法，不要使程序每次执行太长时间的工作（每次执行太长时间的工作有时候不可避免，但大多数时候，是可以的）

Answer 2

谢谢!加doevents对减少CPU占用本身好像是没什么用处吧?我加了,还是一样死掉.是弄得连任务管理器都死掉的那种,连想结束进程都结束不了.
我的循环大是有点大的.

Answer 3

请教大侠们,这个占用CPU过高是不是vb程序特有的现象还是说VC 或者delphi的程序就不会呢?

Answer 4

我觉得应该是有办法解决的,我看那个金山毒霸他全盘杀毒的时候,那个循环大吧长吧,可是他占CPU我看他稳定地在10%几的样子.

Answer 5

递归，估计你耗尽了系统堆栈吧，但是如果是耗尽堆栈应该也是提示堆栈溢出，而不应该将管理器也弄趴下啊
我还真不知道如何将管理器弄趴下呢你在IDE执行，看看Ctr-break能否进入调试

Answer 6

一个搜索代码,因为要搜多个条件,因此多次调用,比如这样:
sousuo=SearchFileInPath("e:","*" & text1 & "*.*")
sousuo=SearchFileInPath("e:","*" & text2 & "*.*")
...
多几个就会趴下.Option Explicit
Private FoundFile() As String '存放传回值的字串阵列
Private Ntx As LongPublic Function SearchFileInPath(ByVal thePath As String, ByVal theFileName As String, Optional ByVal mStop As Boolean = False) As String()
If Right(thePath, 1) <> "\" Then thePath = thePath & "\"
    Call GetFileLoop(thePath, theFileName, mStop)
    SearchFileInPath = FoundFile
End FunctionPrivate Function GetFileLoop(CurrentPath As String, ByVal SearFile As String, Optional ByVal mStop As Boolean = False) As String
    Dim nI As Integer, nDirectory As Integer, i As Long
    Dim sFileName As String, sDirectoryList() As String
  ' Ntx = 0
    On Error Resume Next
    sFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)
    Do While sFileName <> ""
        If UCase(sFileName) Like UCase(SearFile) Then
            i = GetAttr(CurrentPath + sFileName)
            If (i And vbDirectory) = 0 Then
                If mStop = False Then
                    ReDim Preserve FoundFile(Ntx)
                    FoundFile(Ntx) = CurrentPath + sFileName
                    Ntx = Ntx + 1
                Else
                    GetFileLoop = CurrentPath + sFileName
                    Exit Function
                End If
            End If
        End If
        If sFileName <> "." And sFileName <> ".." Then
            If GetAttr(CurrentPath & sFileName) _
            And vbDirectory Then
                
                nDirectory = nDirectory + 1
                ReDim Preserve sDirectoryList(nDirectory)
                sDirectoryList(nDirectory) = CurrentPath & sFileName
            End If
        End If
        sFileName = Dir
    Loop
    For nI = 1 To nDirectory
         GetFileLoop = GetFileLoop(sDirectoryList(nI) & "\", SearFile)
         If GetFileLoop <> "" And mStop = True Then Exit For
    Next nI
End Function

Answer 7

本帖最后由 bcrun 于 2012-02-29 20:36:42 编辑

  

Answer 8

这代码咋这么眼熟呢....ReDim Preserve FoundFile(Ntx)
FoundFile(Ntx) = CurrentPath + sFileName
Ntx = Ntx + 1sleep 1           '这后面加一句sleep 1就不会有那么高的CPU占用了.

Answer 9

事情都做不完，还sleep :)

Answer 10

没办法啦.文件太多,时间肯定是要消耗的,但主要消耗是在磁盘IO上,不应该在CPU上消耗太多了

Answer 11

老马大侠现身了,这个就是您老人家的代码.
sleep 我加过了,而且另外在:
    For nI = 1 To nDirectory
         GetFileLoop = GetFileLoop(sDirectoryList(nI) & "\", SearFile)
         If GetFileLoop <> "" And mStop = True Then Exit For
    Next nI
里面我也给加了sleep:
    For nI = 1 To nDirectory
doevents
sleep 10
         GetFileLoop = GetFileLoop(sDirectoryList(nI) & "\", SearFile)
         If GetFileLoop <> "" And mStop = True Then Exit For
    Next nI
好像没什么效果,不知道怎么回事.我再看看.谢谢!
在这里看到个人家的方法,但是还没弄清楚怎么调用:http://www.yeshack.com/t_9189_1_1.shtml
:
交替使用NtSuspendProcess和 NtResumeProcess来限制单
个进程的 CPU 占用率。首先，一旦进程被暂停，自然就不能占用CPU 了，其次，暂停进程只
会拖慢进程工作，不会扰乱进程工作。我随后就编码测试，结果证明，这个看似脑残的想法
竟然十分有效。解决方案整个解决方案的流程很简单，只有两步：  
1.获得要限制CPU 占用率的进程的句柄；
2.每隔 50ms，依次调用 NtSuspendProcess 和 NtResumeProcess。比如第 50ms 调用了
NtSuspendProcess，第100ms就调用NtResumeProcess。第150ms调用NtSuspendProcess，
第 200ms就调用NtResumeProcess，如此类推下去。程序代码如下：Private Declare Function  OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function  NtSuspendProcess Lib "ntdll.dll" (ByVal hProc As Long)
As Long
Private  Declare  Function  NtResumeProcess Lib "ntdll.dll" (ByVal hProc As Long) As Long
Private hProc As Long
Private Sub LimitCPU_Click()
    hProc = OpenProcess(&H1F0FFF, 0, CLng(Text1.Text))
    WorkingTimer.Interval = 50 '时间间隔为50ms
    WorkingTimer.Enabled = True '开始限制CPU占用率
End Sub
Private Sub WorkingTimer_Timer()
Static x As Long
If x = 0 Then
    x = 1
    NtSuspendProcess hProcElse
    x = 0
    NtResumeProcess hProc
EndIf
End Sub他这个Text1.Text里面要填的是不是程序名还是什么呢?
我放到form_load里面,想一开始就限制程序自身cpu占用.不对:
Private Sub form_load()
hProc = OpenProcess(&H1F0FFF, 0, CLng(app.exename & ".exe"))WorkingTimer.Interval = 50 '时间间隔为50ms
WorkingTimer.Enabled = True '开始限制CPU占用率
end sub