時間を待たせるには

解決

---

１つの処理をするたびにデータベースに書き込んでいってるのですが，
同じレコードを書き込もうとしたら時間を１秒またせて処理を
行わせようと思ってます。処理した時間をnowでとってきて主キーの中に
時間も設定してます。
この時，１秒待たせるのはどうしたらいいでしょうか。
now = dateadd("s",1,now)
とかしてみましたが意味なかったです・・・

編集 削除

---

空ループ使って一秒間、空の仕事をやらせればいいと思われる。

編集 削除

---

Do Until Now >= WaitTime
  DoEvents
Loop

でいけました。

編集 削除

---

> Do Until Now >= WaitTime
>   DoEvents
> Loop
>
↑じゃ、誤差の関係でまずくないですか？
例えば現在の時間(now)が15:33:00.000の時なら15:33:01.000になった時に１秒
経過したのだけど、15:33:00.999だったら1ミリ秒経過したらループを抜けてし
まいますよ。
timeGetTime API等を使用して差分をとり、1000ミリ秒以上経過したところでル
ープを抜けるようにした方がよいですよ。

編集 削除

---

それほどシビアでないなら、
    Dim WaitTime As Single
    WaitTime = Timer + 1!
    Do Until Timer >= WaitTime
        DoEvents
    Loop
程度で十分ではないかと・・・。

編集 削除

---

hh:mm:ssの形式でとっているので
現状で多分大丈夫だと思うのですがやっぱりGODさん
が言うようにAPIを使うべきなのかなぁ〜
でも，このためにAPIを使用するのもちょっと危ない気がしますし・・

編集 削除

---

内部時間ですので取得形式がhh:mm:ssの形式でも
1ms〜1000msの間の待ち時間となってしまいます。

待ち関数を作成してみましたので ご参考にどうぞ。

使用法： SLEEP [待ち時間(msec)]

-<<標準モジュールに記述>>--------------------------------------------
Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Sub SLEEP(msec As Long)
    Dim lngStartTime As Long
    lngStartTime = timeGetTime()
    While timeGetTime() < (lngStartTime + msec)
        DoEvents
    Wend
End Sub
---------------------------------------------------------------------

編集 削除

---

なんか色々レスが付いてるが、
declare function timeGetTime Lib "winmm.dll" () as long
sub wait(byval nMSec as long)
nmsec=nmsec+timegettime
do while timegettime<nmsec
  doevents
loop
end sub

の方がすっきりしてると思われる…( ; ゜Д゜)＜駄レス…

編集 削除

---

前にも書いた話ですが、この手の返り値の値の範囲に上限があって、一定周期でループしている関数やAPIを使う事の怖さをわかっていない方が多いようなのでもう一度書いておきます。


値に上限がある
    ↓
上限より大きい値になるまで待とうとすると無限ループになる

って事を考えると、実は

> Do Until Now >= WaitTime
>   DoEvents
> Loop

以外は全部バグ有りですよ。

編集 削除

---

ソレを言っちゃ バグのないプログラムなんて存在しませんよ
Microsoft Windowsという不安定なOSの上で動作する
処理の多い高級言語 ネイティブコードコンパイルしたところで
処理数はかなりの数になります。
ハードにもバグがないとも限りません
実際 数年前にPentiumでバグがありましたしね。

ですので キリがないと思いますよ

編集 削除

---

>ソレを言っちゃ バグのないプログラムなんて存在しませんよ
いやいや、ひろさんの言ってることはなかなか重要なことです。
WindowsもNT系になって、長時間使っても、なかなか落ちなくなった。
特にサーバーなんかだと気をつけなくっちゃ。

>実際 数年前にPentiumでバグがありましたしね。
あの計算違いを起こすPenは安く売られたんでしたっけ。

編集 削除

---

…バグ…か
> Do Until Now >= WaitTime
>   DoEvents
> Loop
はいつ誤作動が起こるんだろうな…ちょと気になる。
まぁtimeGetTimeは結構早く危なくなるけど…その前にＯＳが危ないか(orz
(,,゜Д゜)＜以上バグレスでした(orz

編集 削除

---

バグがあったのですね・・；
失礼しました＞＜

終わってますが 一応参考に こんなのでも
Declare Function Sleep Lib "kernel32" (ByVal s As Long) As Long

編集 削除

---

何かスレ延びてますね。
timeGetTime のバグの話ですけど、連続で49.7日間(?)連続動作させた時に0に戻
ると言うことではなかったかな？(1msを1として表した時のunsigned Longの最高)
足し算する時にタイミング(24日目くらい)により実行時エラー(オーバーフロー)
がでそうですね。多分、無限ループすることはないでしょう。
OSの動作自体2000でもサービスパック当ててあれば47x日くらいまではWM_TIMER
は正しく発生するように修正されているので結構丈夫にはなったのではないでし
ょうか。他の要因で落ちないとも限りませんけど。
Sleepについてですが、イベントが発生しなくなるのであまりお薦めはしたくない
ですね。(特に通信系をイベントで処理するような時には)

編集 削除

---

>timeGetTime のバグの話ですけど、連続で49.7日間(?)連続動作させた時に0に戻
>ると言うことではなかったかな？(1msを1として表した時のunsigned Longの最高)
>足し算する時にタイミング(24日目くらい)により実行時エラー(オーバーフロー)
>がでそうですね。多分、無限ループすることはないでしょう。

そうですね。終了予定時間をLongで保持する場合は無限ループではなくて

・実行時エラーが出る事がある
・Long型が符号付き３２ビット整数なので大小の比較が誤った判定結果を返す場合がある（それにより、運が悪いとウェイト時間が４９．７日長くなってしまう）

ということになりますね。

# Nowの代わりにGetSystemTime で現在時刻をミリ秒まで取得してループさせれば
# 精度もオーバーフローも問題がない気がしますが、処理が複雑になるので非常に
# 短い時間のウェイトには向いていませんね。

編集 削除

---

そういえば、Win95辺りだと使えないかもしれないけど(昔のマシンどっか行った…)、
QueryPerformanceCounter()とQueryPerformanceFrequency()がおいしいかもしれない。

…とゆーか、一秒待たせるならタイマーで監視……
ん、タイマーにも何かバグがあった予感。
2kだっけか？…ＳＰ出たとか見たことあるけど、不明(orz

( ´Д｀)＜時間待ちも結構シビアだな…境界問題挟まれば皆そうか(ororz

編集 削除

---

orz＜2kのタイマーについて言及してあることを見逃してました

ごめんなさい；；

編集 削除

---

１、CPUにあまり負担をかけない。
２、スレッドを止めない。
３、ある程度精度がある。
４、オーバーフローがない。
この４項目をクリアーするには

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const maxTime = 2 ^ 32
'****************************
'*   指定時間Waiteする関数   *
'****************************
Private Sub timeWaitTime(ByVal waitTime As Double)
    Dim BackTime As Double
    BackTime = timeGetTime '計測開始時間
    Do
        If timeGetTime - BackTime < 0 Then
            'オーバーフォロー処理
            waitTime = waitTime - (maxTime - BackTime)
            BackTime = 0
        End If
        Sleep (1)
        DoEvents
    Loop While (timeGetTime - BackTime < waitTime)
End Sub

こんなことをすればいいのかな。

編集 削除

---

VBのLongは符号付だから、
timeGetTimeが&h7fffffffから&h80000000に変わる状態を考えてみる。

waitTime=1000(1秒)
timeGetTime=&h80000000
BackTime=&h7fffffff
の状態。
(timeGetTimeとBackTimeの差が１なんてありえないけど)

> If timeGetTime - BackTime < 0 Then
問題なく、境界を検査できると思う。

で、入ってきて、
>     'オーバーフォロー処理
>     waitTime = waitTime - (maxTime - BackTime)
maxTimeは(Double型の正の)2^32、BackTimeは(Double型の正の)2^31-1なので、
2^32-(2^31-1)=(Double型の正の)2147483649
よって、
waitTime=1000-2147483649=-2147482649

>     BackTime = 0
境界は正→負もありえる(と思う)ので、BackTimeが一概に正の最小値になるとは限らないかも。

> End If

※誤爆してるかも…特にtimeGetTimeの戻り値が正→負になるかどうか…(orz
  詳しい人教えてください；；

編集 削除

---

ねろさん、おしいです。
正から負へ転じる時にオーバーフロー処理をするのはいいのですが、そこの処理が
何回も行われてしまうのがいけないですね。
49.71/2日なんて待っていられませんのでtimeGetTime の変わりに簡単なダミー関
数を作成して検証しました。

Private Sub Command1_Click()
    Call timeWaitTime(10000)
End Sub

'****************************
'*   指定時間Waiteする関数   *
'****************************
Private Sub timeWaitTime(ByVal waitTime As Double)
    Dim BackTime As Double
    Dim lngCount As Long
    Dim blnFlg As Boolean

    BackTime = hogehoge(lngCount) '計測開始時間
    Do
        lngCount = lngCount + 1
        If hogehoge(lngCount) - BackTime < 0 Then
            If Not blnFlg Then
                'オーバーフォロー処理
                waitTime = waitTime - (maxTime - BackTime)
                BackTime = 0
                blnFlg = True
            End If
        End If
        'Sleep (1)
        DoEvents
    Loop While (hogehoge(lngCount) - BackTime < waitTime)
    Debug.Print lngCount
End Sub

Private Function hogehoge(lngCount As Long) As Long
    If lngCount = 0 Then
        hogehoge = &H7FFFFFFF
        'hogehoge = -1
    Else
        hogehoge = &H80000000 + lngCount - 1
        'hogehoge = lngCount - 1
    End If
End Function

>※誤爆してるかも…特にtimeGetTimeの戻り値が正→負になるかどうか…(orz
>  詳しい人教えてください；；
>
別に詳しいわけではないけど戻り値として32bitの値が返ってくるのです。
それをVBのLong型がどのように解釈するかだけではないですか？(MSBを符号として
解釈するなど)
以下MSDNの内容の一部：
  戻り値は 0 ミリ秒から 2^32 ミリ秒の間を循環します。

APIを使用するときもVBの関数を使用するときも一度ヘルプを呼んで仕様を理解した
後に使用して下さい。ヘルプを読まずに勘でプログラムを書くから怖い結果になっ
てしまうのだと思いますよ。

編集 削除

---

> GODさん

> 別に詳しいわけではないけど戻り値として32bitの値が返ってくるのです。
> それをVBのLong型がどのように解釈するかだけではないですか？(MSBを符号として
> 解釈するなど)
> 以下MSDNの内容の一部：
>   戻り値は 0 ミリ秒から 2^32 ミリ秒の間を循環します。
この情報は私も知っています。
ですが、実際に49.71/2日稼動し続けたことが無いので、挙動が不明なのです。
GODさんは挙動を確認したと考えてよろしいのですよね？

編集 削除

---

>ガッさんありがとう。
おっしゃる通り、だめだなこりゃ。話をややこしくしてしまった。
>にtimeGetTimeの戻り値が正→負になるかどうか
戻り値はDwordで来るけど、計算したとたんにLongになってしまう。(^^;

そこで修正。
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const maxTime = 2 ^ 32 - 1     'ここも違ってた
'****************************
'*   指定時間Waitする関数   *
'****************************
Private Sub timeWaitTime(ByVal waitTime As Double)
    Dim BackTime As Double
    Dim TTime As Double
    BackTime = timeGetTimeVb '計測開始時間
    Do
        'TTime = timeGetTimeVb
        If timeGetTimeVb - BackTime < 0 Then
            'オーバーフォロー処理
            waitTime = waitTime - (maxTime - BackTime)
            BackTime = 0
        End If
        Sleep (1)
        DoEvents
    Loop While (timeGetTimeVb - BackTime < waitTime)
End Sub
Private Function timeGetTimeVb() As Double
    'timeGetTimeをDoubleに変換
    Dim TempTime As Double
    TempTime = timeGetTime
    If TempTime < 0 Then
        timeGetTimeVb = maxTime + TempTime + 1
    Else
        timeGetTimeVb = TempTime
    End If
End Function

こんなのでどうかな、どこか違ってそうな予感。
一ヶ月位稼動してるコンピューターは有るが、やって見る気はしない。

>GODさんありがとう。
lngCountがtimeGetTimeですか？
>   If lngCount = 0 Then
>        hogehoge = &H7FFFFFFF
ここが私にはわかりにくい。

>APIを使用するときもVBの関数を使用するときも一度ヘルプを呼んで仕様を理解した
>後に使用して下さい。
すみません、一応英語と日本語両方読んだつもりですが、未熟と言うことでひとつ。。。。

編集 削除

---

>> 以下MSDNの内容の一部：
>>   戻り値は 0 ミリ秒から 2^32 ミリ秒の間を循環します。
>この情報は私も知っています。
>ですが、実際に49.71/2日稼動し続けたことが無いので、挙動が不明なのです。
>GODさんは挙動を確認したと考えてよろしいのですよね？
>
私も実質そこまでの動作確認は行ってません。(ヘルプに書かれている戻り値の結果
が違うのなら変な動作をするでしょうけど。)
私は他の検証方法としてＣ言語にてDLLを作成(戻り値をtimeGetTimeと同じDWORD)
して確認したところ前述した通りの結果になっただけです。
(↑昔の実験では。32bitうんぬんの事ね。)

// 今急いで確認できそうなサンプル作って見たのでよろしかったらどうぞ。
// C側。DLL作成ファイル名はDLLTest.DLLとする
__declspec(dllexport) DWORD WINAPI TestFnc(DWORD dwCount)
{
  DWORD dwBase;

  dwBase = 0x7ffffff0;
  return (dwBase + dwCount);
}

'VB側
Private Declare Function TestFnc Lib "DLLTest.dll" (ByVal dwCount As Long) As Long

Private Sub Command1_Click()
    Dim lngCount As Long
    
    For lngCount = 0 To 100
        Debug.Print TestFnc(lngCount)
    Next
End Sub

編集 削除

---

ねろさんへ

> lngCountがtimeGetTimeですか？
timeGetTime関数の変わりはhogehoge関数です。
lngCountは経過ミリ秒の代わりです。
実際、hogehoge関数を呼んだだけだと数が大きくなっていかないので引き数でダ
ミーで経過ミリ秒を持たせて実験を行いました。

>>   If lngCount = 0 Then
>>        hogehoge = &H7FFFFFFF
>ここが私にはわかりにくい。
>
今回の確認は正から負に移行したときの処理確認なのでlngCount(経過ミリ秒)が
0の時に正の最大値である7FFFFFFFHを返し、1ミリ秒以上経過した時に負の値を
返すように組んであります。
コメントを付け替えれば負から正の確認ができると思います。

私はblnFlgで２回以上オーバーフロー処理に突入しないように改造してあります。
blnFlgをコメントにしてステップ実行していただければ正しく動作しない現象が
確認できると思います。
最後にイミディエイトに経過ミリ秒(ループ回数)を表示するようになっています。

よけいに混乱させてしまったらどうしよ＾＾；

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。