VBScript で現在日時を秒未満の情報と共に取得する (unibon)

1999年09月14日: 新規作成。

VBScript で現在日時を秒未満の情報と共に取得します。
これは何を問題としているかと言えば、VBScript で現在日時を求めるには普段は Now 関数を使えば良いのですが、これでは精度が「秒」までです。大体の時刻を知る場合ならばこれで事足りることが多いですが、細かな時刻を知りたいときには不満があります。VBScript の Date 型の表現範囲が広い(西暦 100 年から 9999 年まで表現できる)ため、精度が犠牲になっているのだと思われます。
一方、VBScript には別に Timer 関数があり、これは精度が若干高く、50 ミリ秒程度の細かさがあります。しかし、これは1日の内の時刻しか求まらず、真夜中の0時になるとリセットされてしまいます。
現在日時として、「年月日時分秒」と共に「ミリ秒」も求めるためには、上記の2つの関数を組み合わせて使えば良いわけですが、単に2つの関数を続けて呼び出しただけでは、厳密には正しい情報が得られません。これは、Now 関数と Timer 関数を同時に呼び出すわけにはいかず、順番に呼び出すために取得した情報が、同一時刻のものではないためです。
すなわち、予想される問題としては、たとえば、Now 関数を呼び出した時点で、1999/09/15 23:59:59.960 (Date 型の精度では 1999/09/15 23:59:59 まで得られる)だったが、Timer 関数を呼び出した時点では 1999/09/16 00:00:00.010 (Timer の持つ情報としては 00:00:00:010)だった場合です。これらを単純に合成してしまうと 1999/09/15 00:00:00.010 となり、約1日の誤差が発生してしまいます。
関数 NowTimer では、これらの対処をおこなっています。これを呼び出す ASP 用のサンプルプログラムを示します。なお、MyFormatDate 関数は、単に日時を整形して文字列に加工するだけのものです。

使用例:

<%@Language=VBScript EnableSessionState=False%>
<%Option Explicit%>
<HTML>
<HEAD>
<TITLE>ミリ秒と共に現在日時を得る</TITLE>
</HEAD>
<BODY>
<%

' ここに NowTimer 関数を記述してください。

Function MyFormatDate(ByVal a, ByVal b)
    Dim s
    s = Right("000" & Year(a), 4) & "/" & Right("0" & Month(a), 2) & "/" & Right("0" & Day(a), 2) _
    & " " & Right("0" & Hour(a), 2) & ":" & Right("0" & Minute(a), 2) & ":" & Right("0" & Second(a), 2) _
    & "." & Right("00" & CStr(b), 3)

    MyFormatDate = s
End Function

Dim a
Dim b
Call NowTimer(a, b)
Dim s
s = MyFormatDate(a, b)
Call Response.Write("start = " & s & "<BR>" & vbNewLine)

Dim i
For i = 0 To 10 - 1 ' ループ回数はマシンスペックに応じて増減してください。
    Call Response.Write("i = " & i & "<BR>" & vbNewLine)
Next

Call NowTimer(a, b)
s = MyFormatDate(a, b)
Call Response.Write("end = " & s & "<BR>" & vbNewLine)
%>
</BODY>
</HTML>

Sub NowTimer(ByRef md, ByRef ms) ' md: Date 型の「年月日時分秒」, ms: Long 型の「ミリ秒」
    Dim t
    t = CDbl(Timer()) ' Timer() から得られた「時分秒」の情報。(「秒」単位、小数を含む。「年月日」の情報は持たない。)
    Dim u
    u = CLng(Int(t)) ' Timer() から得られた「時分秒」の情報。(「秒」単位、小数を含まない。「年月日」の情報は持たない。)
    Dim v
    v = CLng(Int((t - u) * 1000)) ' Timer() から得られた「ミリ秒」の情報。(「ミリ秒」単位。「年月日時分秒」の情報は持たない。)

    Dim n
    n = Now() ' Now() から得られた「年月日時分秒」の情報。(Date 型。「ミリ秒」の情報は持たない。)
    Dim ymd
    ymd = DateSerial(Year(n), Month(n), Day(n)) ' Now() から得られた「年月日」の情報(「時分秒」の情報は持たない)
    Dim hms
    hms = Hour(n) * 3600 + Minute(n) * 60 + Second(n) ' Now() から得られた「時分秒」の情報(「年月日」の情報は持たない)

    Dim x
    If abs(u - hms) >= 43200 Then ' 真夜中の 0 時を跨いだ場合(24*60*60/2)。
        x = DateAdd("d", -1, ymd)
    Else ' 普通の場合。
        x = ymd
    End If

    Dim y
    y = DateAdd("s", u, x) ' Timer 関数の呼び出し時点での時刻を優先する。

    md = y
    ms = v
End Sub

ASP の目次
ホーム
(このページ自身の絶対的な URL)