Zenn
📘

【Visual Basic 6.0】Sleep関数の不具合

2022/05/26に公開
メモ
sleep
VB6
Windows XP
tech

Sleep関数の不具合と対応方法（サンプルコード付き）

開発環境

カテゴリー 名称 詳細バージョン
ＯＳ Windows XP (SP3) Version:2002
プログラミング言語 Visual Basic 6.0 (SP6) Version:9782

不具合内容

現象
Sleep関数を使用しているロジックが実行され続けていると、動作が遅くなる。タスクマネージャーで確認したところ、ハンドルとメモリ使用率ともに高くなっている状況で、ハングアップしていた。

原因
Sleep関数を使用している間に発生したイベントをハンドル出来なかったため、ハングアップした状態となった。
これは、Sleep関数の不具合？で、MicrosoftもSleep関数を使用することを推奨していないらしい。

対応方法
Sleep関数から、SetWaitableTimer関数を使用した待機関数へ変更

Sleep関数について

プログラムの実行を一時停止するために、Sleep関数が多く使用されています。
しかし、Sleepにはアプリケーションが実行されているスレッドを一時停止するため、開いているウィンドウが正しく再描画されないなどの欠点があります。
対応策としてSleepの代わりに、SetWaitableTimerを使用することができます。これにより、画面の再描画やDDEメッセージの受信などが可能になります。

サンプルコード

[プロジェクト]メニューから、[モジュールの追加]をクリックして、プロジェクトに新しいモジュール（Wait.bas）を追加し、使用してください。
Wait関数は処理を止める時間を秒単位で指定することができます。

Wait.bas
Option Explicit

  Private Type FILETIME
      dwLowDateTime As Long
      dwHighDateTime As Long
  End Type

  Private 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 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 Long

  Public Sub Wait(lNumberOfSeconds As Long)
      Dim ft As FILETIME
      Dim lBusy As Long
      Dim lRet As Long
      Dim dblDelay As Double
      Dim dblDelayLow As Double
      Dim dblUnits As Double
      Dim hTimer As Long
     
      hTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer")
      
      If Err.LastDllError = ERROR_ALREADY_EXISTS Then
          ' タイマーがすでに存在する　かつ　適切なアクセス権を持っている場合は正常
      Else
          ft.dwLowDateTime = -1
          ft.dwHighDateTime = -1
          lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
      End If
      
      ' 単位をナノ秒に変換
      dblUnits = CDbl(&H10000) * CDbl(&H10000)
      dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000
      ' ※Wait関数をミリ秒で指定したい場合は、上のコードをこちらに置き換えて下さい
      ' dblDelay = CDbl(lNumberOfSeconds) * 10 * 1000
      
      ' SetWaitableTimerの待機時間にオフセット時間を使用
      ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
      dblDelayLow = -dblUnits * (dblDelay / dblUnits - Fix(dblDelay / dblUnits))
      
      If dblDelayLow < CDbl(&H80000000) Then
          ' FILETIME構造体のオーバーフローチェック
          dblDelayLow = dblUnits + dblDelayLow
      End If
      
      ft.dwLowDateTime = CLng(dblDelayLow)
      lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
      
      Do
          ' QS_ALLINPUTを指定し、メッセージの割り込みを許可する
          lBusy = MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT&)
          DoEvents
      Loop Until lBusy = WAIT_OBJECT_0
      
      ' 使い終わったらハンドルを閉じる
      CloseHandle hTimer

  End Sub

引用

https://jeffpar.github.io/kbarchive/kb/231/Q231298/

追記

各API関数の微妙な違いについて

  1. Sleep
    指定された時間にわたって、現在のスレッドの実行を中断する。

  2. SleepEx
    指定された時間にわたって、現在のスレッドの実行を中断する。
    次の条件のいずれかが満たされると、実行を再開する。

    • I/O 完了コールバック関数が呼び出し
    • 非同期プロシージャコール（APC）オブジェクトが、スレッドの ACP キューに置かれた
    • タイムアウト時間が経過

  3. WaitForMultipleObjects
    指定したオブジェクトのいずれか1つまたはすべてがシグナル状態になったとき、またはタイムアウト時間が経過したとき制御を戻す。

  4. WaitForMultipleObjectsEx
    指定したオブジェクトのいずれか1つまたはすべてがシグナル状態になったとき、または次の条件のいずれかが満たされると、制御を返す。

    • I/O 完了コールバック関数が呼び出し
    • 非同期プロシージャコール（APC）オブジェクトが、スレッドの ACP キューに置かれた
    • タイムアウト時間が経過

Discussion