2009/12/06

VB弾投下っ!・・・


VBScript等で、時刻文字列とか、2つの日時から その差異や平均を取得となると、
簡単なようで、厳密にやろうとすると結構面倒な上、難しいと云うのは、
そのヘン触ったコトのある身なら、ダレでも既知のコトと思う。

で、以前公開した、日付文字列取得関数を簡単に改良した版と、日時の差異を色々な形式で取得できる関数、
変数内データ確認関数、簡単な桁揃え関数などを一纏めにし、且つ、ソレらが連携するよう組んだサンプルを、
以下にうpしてみた。

アーカイブはコチラ ・・・今回は サンプルなので、エンコード版は非同梱。


おやくそくの ひけらかしw

'***** ↓↓↓ScriptTitle↓↓↓ ****************************************************
' dtDiffs (X3FManeger)
' - Created by LazwardFox -

' 時間文字列取得関数と、時間差取得関数のテストパッケージ。
' mSecレベルを未処理な為、平均時間取得で、秒の精度が低い。

' 特徴)
' 時間差異取得関数 dtDiff で 得られる差異は最大、9999/12/31 23:59:59
' また、比較時刻に差異が無かった場合には、既存日付関数では取得不可能な、
' 0年0ヶ月0日 0時間0分0秒を、様々な形式の値として取得可能。

' 注)
' 上記特徴に起因し、時間差異取得関数 dtDiff で 得た値は、
' 概ね、そのまま日付処理関数に代入できない。

' Tips 01)
' VBScriptの時刻取得関数で得られた値には、ミリ秒が含まれる。
' が、このスクリプトに含まれる処理だけでは、
' ソレを表示結果に反映させるコトは出来ない。
' (JavaScriptにある、MilliSeconds に、該当する関数はナイ)

' Tips 02)
' テストで用いている Sleep関数は、1/1000秒レベルの精度を持たない。
' 故に、テストでのミリ秒の値は安定しない。
' つまり、.Sleep 3000 としても、ジャスト3000mSecでは動作していない。
' (JavaScriptで類似処理を用いても、ほぼ同様)

' 単純数値化
' yyyymmddhhnnss と結果を並べて、(倍精度)整数に変換したモノ。
' もし仮に、結果の差異が 11年 6ヶ月 2日 16時間 22分 4秒 であった場合、
' 110602162204 が(文字列ではなく)整数で返される。


' それら特徴や問題に起因し、平均値を得るに、
' 丁度割り切れる秒数でナイ場合の精度は期待できない。


' Update -------- ----
' Release -------- ----
' Update 20091206 0307 平均値出力暫定追加(ミリSecレベル未対応版)
' Update 20091206 0247 公開用にX3FManegerから分離し、テストスクリプト化。
' βRelease 20091011 0625
' DevStart 20091010 1549

'***** ↓↓↓ ObjectDecralations ↓↓↓ *******************************************
Public My, Fs ', Parameters, MySh,
Set My = WScript
With My
'Set Parameters = .Arguments ' パラメーター取得
'If Parameters.Count <= 0 Then ' パラメータなし起動の無効化
' .Quit
'End If

'Set MySh = .CreateObject("WScript.Shell")
Set Fs = .CreateObject("Scripting.FileSystemObject")
'Set objSMTP = .CreateObject("CDO.Message") ' SMTP Object
'Set objMx = .CreateObject("MSXML2.XMLHTTP") ' URL Check
End With

'***** ↓↓↓ Decralations ↓↓↓ *************************************************

' Const - Letters
Dim vbWCrLf, vbTc
Const vbWq = """"
vbWCrLf = vbCrLf & vbCrLf
vbTc = vbTab & vbCrLf

' Const - Date/Times


'***** ↓↓↓ LocalDecralations ↓↓↓ ********************************************
Dim sStartTime, sEndTime, ElapsedTime
Dim StartTime, EndTime
Dim strReport
strReport = "時間差異と平均時間取得テスト" & " " & vbWCrLf

'***** ↓↓↓ TestParameter Decralations ↓↓↓ ***********************************
Const sPar = 3 ' テスト用平均値取得パラメータ

'***** ↓↓↓MainRoutine↓↓↓ ****************************************************
'On Error Resume Next
sStartTime = Now() ' 開始時刻シリアル値取得
My.Sleep 6000 ' テスト間隔
sEndTime = Now() ' 終了時刻シリアル値取得
dtDiff sStartTime, sEndTime, sPar, ElapsedTime ' 経過時間
iDT sStartTime,,,, 0, StartTime ' 開始時刻文字列取得
iDT sEndTime,,,, 0, EndTime ' 終了時刻文字列取得

strReport = strReport & "みなし処理回数 - " & sPar & " " & vbWCrLf

strReport = strReport & "開始-" & StartTime & " " & vbCrLf
strReport = strReport & "終了-" & EndTime & " " & vbCrLf
strReport = strReport & "経過-" & Join(ElapsedTime(0)," ") & " " & vbCrLf
strReport = strReport & "経過時間単純数値化-" & ElapsedTime(1) & " " & vbCrLf
strReport = strReport & "平均-" & Join(ElapsedTime(2)," ") & " " & vbCrLf
strReport = strReport & "平均時間単純数値化-" & ElapsedTime(3) & " "
Msgbox strReport & " ",,Fs.GetBaseName(My.ScriptName)
Set Fs = Nothing
'Set MySh = Nothing
My.Quit

'***** ↓↓↓Functions↓↓↓ ******************************************************

' X3FManeger (fCopy)
'------------------------------------
' iDT - 日時文字列 ないし 日/時配列取得 for VBScript
' - Created by LazwardFox -

' VarChk

' Update 20091103 1149 パラメータチェックを完全外部化。
' Update 20091010 1736 文字列/シリアル値による日時指定、
' 及び パラメータ省略に対応。
' Update 20090228 0458 変数宣言変更
' Update 20090223 0959 時刻桁処理変更
' Update 20090223 0253 Len記述忘れ修正
' Update 20090223 0135 変数宣言忘れ修正
' Update 20090210 0218
' Update 20090210 0115
' Release 20090209 2035

' iDT (
' {tDateTime} - Serial / DateTimeStrings (省略可、既定値 - Now)
' ,{dSplitter} - DateSplitString (省略可、既定値 - "/")
' ,{dtSeparater} - Date/Time SepaleteString (省略可、既定値 - " ")
' ,{tSplitter} - TimeSplitString (省略可、既定値 - ":")
' ,{Control} - 戻り値 文字列/配列指定 0 or 1 (省略可、既定値 - 1)
' ,Result - 結果日時文字列 (省略不可)
' )

' Memo - いずれかのSplitterに ~|" を設定すると、全ての要素が、配列として返されます。
' iDT ,"|",,,,arDT ' - (0) YYYY / (1) MM / (2) DD / (3) HH / (4) NN / (5) SS

Public Function iDT(tDateTime, dSplitter, dtSeparater, tSplitter, Control, Result)
Dim vDateTime, cDateTime, nD, nS, strYMD, strHNS
Dim dVal, cVar, arVar
dVal = Array(Now(),"/"," ",":",1) ' 既定値配列
cVar = Array(Array(tDateTime,7,False,dVal(0)),Array(dSplitter,10,True,dVal(1)), _
Array(dtSeparater,10,True,dVal(2)),Array(tSplitter,10,True,dVal(3)), _
Array(Control,2,False,dVal(4)))
arVar = VarChk(cVar)
tDateTime = arVar(0)
strYMD = FormatDateTime(DateValue(tDateTime),0) 'Update 20091010 1736
nS = ":" & Split(CStr(FormatDateTime(tDateTime,3)),":")(2) 'Update 20090223 0951
strHNS = FormatDateTime(tDateTime,4) & nS 'Update 20090223 0951
If arVar(3) = dVal(3) Then
Else
strHNS = Replace(strHNS,dVal(3),arVar(3))
End If
If arVar(1) = dVal(1) Then
Else
strYMD = Cstr(Replace(strYMD,dVal(1),arVar(1)))
End If
If arVar(4) = dVal(4) Then
Result = Split(strYMD & "|" & strHNS,"|")
Else
Result = strYMD & arVar(2) & strHNS
End If
End Function

' X3FManeger (fCopy)
'------------------------------------
' VarChk
' 変数内データの確認と、既定値への置換をサポート。
' 関数への代入パラメータ確認向け
' - Created by LazwardFox -

' Update
' Release
' βRelease 20091103 1152
' DevStart 20091103 1014

' VarChk - 結果を配列で返す。
' (
' arVar - 調査対象と条件を配列で代入する。 (省略不可)
' )

' arVar = Array(Array(Value,VarTypes,Boolean,DefaultData),Array(Value,VarTypes,Boolean,DefaultData),・・・)

' Value - 確認対象となる値、ないし変数
' VarTypes - VarType定数 (日時値を得る場合は、基が文字列代入であっても 8 を指定)
' Boolean - 条件の可否
' DefaultData - 代替規定値 (データ型自由)

Function VarChk(arVar)
If VarType(arVar) >= 8192 Then
ReDim iResult(UBound(arVar))
Dim Pc, iVar, cVar ,vVar, vDT, cDT
Pc = 0
For Each iVar In arVar
cVar = VarType(iVar) >= 8192 And Ubound(iVar) = 3
If cVar Then
cVar = VarType(iVar(1)) = 2 And VarType(iVar(2)) = 11
If cVar Then
If iVar(1) = 8 Then
vDT = VarType(iVar(0))
cDT = vDT <> 10 And (vDT = 7 Or (vDT = 8 And IsDate(iVar(0))))
If cDT Then ' シリアル値/日時文字列 識別
iResult(Pc) = DateValue(iVar(0)) + TimeValue(iVar(0))
Else
iResult(Pc) = iVar(3) ' Now()
End If
Else
vVar = VarType(iVar(0))
If iVar(2) = (vVar = iVar(1)) Then
iResult(Pc) = iVar(3)
Else
iResult(Pc) = iVar(0)
End If
End If
End If
End If
Pc = Pc + 1
Next
End If
VarChk = iResult
End Function

' X3FManeger
'------------------------------------
' dtDiff
' 日時値の差異を取得。
' "各単位の差異のみを単純に取得"するDateDiffとは異なる。
' ※ iDTの仕様起因し、利用する場合、コチラを先に実行する必要がある。
' - Created by LazwardFox -

' Digit, VarChk

' Update 20091208 0119 平均値取得時のゼロ除算回避を追記。
' Update 20091206 0626 VarChk使用で、Par 省略に対応。
' Update 20091206 0356 暫定版平均値取得機能追加。
' Update 20091206 0217 差異演算基底日付値に伴う修正。
' Update 20091105 0329 単純化した時間差数値を出力可能に
' Update 20091105 0315 文字列桁揃えをサポート
' Release 20091103 1655
' βRelease 20091103 1626
' DevStart 20091103 1606

' dtDiff - 各単位別の結果を配列で返す。
' Var(0) 日付 - (0) Y / (1) M / (2) D
' Var(1) 時間 - (0) H : (1) N : (2) S
' (
' Before - Serial / DateTimeStrings (省略不可)
' ,{After} - DateSplitString (省略可、既定値 - Now())
' ,{Par} - AverageParameter (省略可、既定値 - 1)
' ,Result - 結果を日/時別の文字列を配列として返す。 (省略不可)
' Result(0)(0) - "Y/M/D" / (1) - "H:N:S"
' Result(1) - YYYYMMDDHHNNSS を並べ、単純数値化した結果が返る。
' Result(2)(0) - "Y/M/D" / (1) - "H:N:S"
' Result(3) - YYYYMMDDHHNNSS を並べ、単純数値化した結果が返る。
' 例) 時間差が 4日と2時間15分5秒 なら 4021505
' )

' Result と Join(Var(0),"/") & " " & Join(Var(1),":") は、等価。
' 数値で、単位別の値の取得が不要であれば、以下書式だけで利用可能。

' dtDiff Before, After, Result

Function dtDiff(Before, After, Par, Result)
If VarType(Before) = 7 Then
Dim cVar, arVar, lDate, Diffs, avDiffs, iResult
cVar = Array(Array(After,7,False,Now()), Array(Par,2,False,1))
arVar = VarChk(cVar)
lDate = DateSerial(0,1,1) ' 差異演算基底日付値 (0,1,1) = 2000/01/01
Diffs = arVar(0) - Before 'After - Before
If arVar(1) > 0 Then
avDiffs = Diffs / arVar(1)
End If
Diffs = lDate + Diffs
avDiffs = lDate + avDiffs
iResult = Array( _
Array(Digit(Year(Diffs) - 2000, "0000"),Digit(Month(Diffs) - 1, "00"),Digit(Day(Diffs) - 1, "00")), _
Array(Digit(Hour(Diffs), "00"), Digit(Minute(Diffs),"00"), Digit(Second(Diffs),"00")), _
Array(Digit(Year(avDiffs) - 2000, "0000"),Digit(Month(avDiffs) - 1, "00"),Digit(Day(avDiffs) - 1, "00")), _
Array(Digit(Hour(avDiffs), "00"), Digit(Minute(avDiffs),"00"), Digit(Second(avDiffs),"00")))
Result = Array(Array(Join(iResult(0),"/"),Join(iResult(1),":")),Cdbl(Join(iResult(0),"") & Join(iResult(1),"")), _
Array(Join(iResult(2),"/"),Join(iResult(3),":")),Cdbl(Join(iResult(2),"") & Join(iResult(3),"")))
dtDiff = iResult
Else
dtDiff = False
End If
End Function

' X3FManeger
'------------------------------------
' Digit
' 文字列表記の数値の桁揃えを行う。
' - Created by LazwardFox -

' Update
' Release
' βRelease 20091105 0303 チョー暫定発行 そにょ2
' DevStart 20091105 ----

Function Digit(Num, dig)
Digit = Right(Clng("1" & dig) + Num, Len(Dig))
End Function



ココまでヤる意味があるかは、利用側の用途次第かw

mSec対応版も組んでたんだけど、時間無くなったので途中のまま・・・(-_-;)
<そのまま使えるVBscript 日時文字列 時刻差異取得>

0 件のコメント:

コメントを投稿