ab.com コミュニティ

FileTimeToSystemTime(ByVal VarPtr(q) As *FILETIME, st)

ft.dwLowDateTime = ( q and &HFFFFFFFF ) As DWord
q = q and &HFFFFFFFF00000000
q = q >> 32
ft.dwHighDateTime = q As DWord

FileTimeToSystemTime(ft, st)

今、気づいたのですが、以下のようなことも出来るということですよね。
ファイルタイムからシステムタイムに直す時、直接SYSTEMTIME。
[code]
FileTimeToSystemTime(ByVal VarPtr(q) As *FILETIME, st)
[/code]
今まで以下の様にやってたのですが、実験したらちゃんと同じ値がでました。
[code]
ft.dwLowDateTime = ( q and &HFFFFFFFF ) As DWord
q = q and &HFFFFFFFF00000000
q = q >> 32
ft.dwHighDateTime = q As DWord

FileTimeToSystemTime(ft, st)
[/code]

konisiさん、イグトランスさん、淡幻星さん、返信有難う御座います。
恥ずかしながら、知らない事ばかりで大変勉強になりました。

なるほど。一旦Double型にしてるから誤差が出るのか。

何度か実験してみたところ、整数除算演算子なら、ズレはでないようです。
わざわざFixしなくても整数部分のみを返してくれるし、便利ですね。
直接QWord型。こんな事が出来るんですね。凄いです。

＞DWord型が無かったときの名残
私もWin32プログラミング講座では、ハンドルがLong型で書かれてるのに
strictにすると注意されるので疑問だったのですが、そういうことなのですね。
しかし、今まで直されてない所を見ると、他のABユーザーはあまり困ってないのかな。
そもそも、FILETIMEを使わないのかもしれませんね。

[quote="西野孝雄さん"]> DWord型に変えた事によって、別のバグがでないかと思い
> FILETIME関連を意味も無く弄ってみましたが、今のところ特に問題無い様です。[/quote]本来ＦＩＬＥＴＩＭＥ構造体はDWordで定義されていますので、
問題は起こりません。
（C/C++がそうですし、利用APIの性質上、マイナスの値は意味を持ちません。）

[quote="西野孝雄さん"]> > しかし、dwLowDateTime/dwHighDateTimeがDWord型ではなく
> Long型で定義されてたのは何故なのでしょう？[/quote]ABに関して言えば、DWord型が無かったとき（記憶違いでしたら失礼）の名残かと＾＾；
例えばハンドルとか、本来はunsigned longのDWord型を使うべきところを、
今でもLong型を使ってますので、私自身＾＾；
どうせキャスト＋Or演算でQWord型にして使うのであれば、
LongだろうとDWordだろうと、動作は一緒になります。

[quote="西野孝雄さん"]> > なので、淡幻星山の仰っている、QWordの除算が正常に動作しないのは、
> 引かないで割った時に起きたのではないでしょうか。[/quote]なるほど。かもしれません（動いたので確かめてません＾＾；）。
確か、減法の部分をQWord型の定数で置き換えて実行したりもしたので、そのときが怪しいですね。
（まだ再現性を確認してませんが、QWordの範囲にある定数が0として扱われていたみたいです。バグ？）


[quote="イグトランスさん"]直接QWord型の変数に[/quote]目から鱗。
せっかくQWord型変数が使えるんですから、そっちの方が良いですね。

ならば整数除算演算子 \ はどうでしょう。
また、SystemTimeToFileTime(st, ByVal VarPtr(q) As *FILETIME)などとすれば直接QWord型の変数に結果を得られると思います。

整数型を除算する時は、内部では一旦Double型にしてから除算するので誤差が生じます。
これはQWord型に正常に（誤差なく）入り切る数値の上限がDouble型の限界を超えているために起こるものかと思いますが。
（Double型とQWord型における正常に行き来可能な数値はQWord型の限界の2048分の1程度だったかと記憶しています。)

このずれはVal関数にも響いていたり、そのせいでprompt/consoleモードのPrint文やInput文などに影響が出てたりもするわけです。


ちなみに。
整数同士の加算減算では内部でDouble型にするような真似をしませんので、誤差は起こらないと考えていいと思います。

淡幻星さん、Tom Daydreamさん、返信有難う御座います。

api_system.sbpの修正、Fixを使わない、DWord型使う
で、実験して、しばらく放っておきましたが、どうやら大丈夫のようです。
大変助かりました。本当にありがとうございます。

DWord型に変えた事によって、別のバグがでないかと思い
FILETIME関連を意味も無く弄ってみましたが、今のところ特に問題無い様です。

しかし、dwLowDateTime/dwHighDateTimeがDWord型ではなく
Long型で定義されてたのは何故なのでしょう？
検索してみると、他言語では、DWord、Long、どちらの定義、説明もあるようです。


少し話しズレますが、FILETIME等のとても大きい数を割ると、
何故なのかは良く分かりませんが、正確な値が出ないようです。
その為に、FILETIMEを割る前に2006年1月1日までのFILETIMEを
引いて値を小さくしているのです。（何故か引き算は値がおかしくならない）
引いた後の小さい値になると、普通に正確な割り算ができました。

なので、淡幻星山の仰っている、QWordの除算が正常に動作しないのは、
引かないで割った時に起きたのではないでしょうか。

q = q + ft.dwLowDateTime     '＊

q = q or ft.dwLowDateTime     '＊

ql = Fix(q / 10000000) As Long 

Dim ql As Long

Dim qd As DWord

'DWord型変数のログを記録するクラス
/*
クラス：LogDWord
	Dim Obj As LogDWord( ログの記録最大数 )
	Obj.Record( ログに保存するDWord型の値 )  ※失敗するとFALSE、成功するとTRUE。普通は成功なので無視してオッケー。
	[DWord型変数のログが返る] = Obj.PlayLog( ログのインデックス )
	インデックスの範囲は、[古い：0～(最大記録数-1)：新しい]　になります。
*/
Class LogDWord
	pDWordArry As DWordPtr
	hHeap As HANDLE
	nIndex As DWord
	nMaxIndex As DWord
Public
	Sub LogDWord( nLog As DWord )
		hHeap = HeapCreate( NULL, 0, 0 )
		pDWordArry = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nLog*SizeOf(DWord) ) As DWordPtr
		nIndex = 0
		nMaxIndex = nLog
	End Sub
	Sub ~LogDWord()
		HeapDestroy( hHeap )
	End Sub

	Function Record( nDWord As DWord ) As Long
		Dim i As Long

		If( pDWordArry=NULL )Then
			Record = FALSE
			ExitFunction
		Else
			Record = TRUE
		End If

		If( nIndex<nMaxIndex )Then
			pDWordArry[ nIndex ] = nDWord
			nIndex += 1
		Else
			i = 1
			While( i<nIndex )
				pDWordArry[ i-1 ] = pDWordArry[ i ]
				i += 1
			Wend
			pDWordArry[ nIndex-1 ] = nDWord
		End If
	End Function

	Function PlayLog( nIndex As DWord ) As DWord
		If( nIndex<nMaxIndex )Then
			PlayLog = pDWordArry[ nIndex ]
		Else
			PlayLog = 0
		End If
	End Function
End Class



'QWord型への変換
Function MakeQWord( LowDWord As DWord, HighDWord As DWord ) As QWord
    Dim q As QWord
    q = HighDWord
    q = q << 32
    q = q + LowDWord
    MakeQWord = q
EndFunction

'DWord型への分解
Function HiDWord( q As QWord ) As DWord
    q = q and &HFFFFFFFF00000000
    q = q >> 32
    HiDWord = q
EndFunction
Function LoDWord( q As QWord ) As DWord
    LoDWord = q and &HFFFFFFFF
EndFunction

[quote="Tom Daydreamさん"]> api_system.sbpのなかで、
> Type FILETIME
> dwLowDateTime As Long
> dwHighDateTime As Long
> End Type
> と定義されているためです。[/quote]
(；ﾟ⊿ﾟ)
･･･そうきたかｗ
そこは考えもしませんでした。

しかし。（＊）の部分を
[code]q = q + ft.dwLowDateTime '＊[/code]
ではなくて
[code]q = q or ft.dwLowDateTime '＊[/code]
にしておけば表面上は問題なかったり（bitをそのまま扱ってるから）。
念のためこっちに直した上でテストしてたので、気づきませんでした（爆）。
で、それ以外にも挙動の変な部分がありまして。
どうも悪さをしているのは、
[code]ql = Fix(q / 10000000) As Long [/code]の部分みたいです。
Fix関数はDouble型→Long型の変換として作られているので、
QWord型では挙動が変です。
なので、
[quote]q = q / 10000000 '※
ql = q As Long[/quote]
としてみましたが、今度は（※）の部分の挙動が信頼できませんでした。
（正常に除算されるときとされないときがありました。）
再現性がイマイチなので、もしかしたら私の勘違いの可能性もありますが･･･。
さらに、
[code]Dim ql As Long[/code]ではなく
[code]Dim qd As DWord[/code]
でも試してみましたが、めだった改善は見られず。
（環境：Win2000 + AB Ver.4.24.00）


うーん、問題の箇所（QWordのキャストと演算）は分かったけれど、
解決法が分からず･･･。
今日はもう時間が無いので、後日の時間のあるときにまたやってみます。

なお、解析のときに私が定義した関数です。
あると便利かと思い、載せておきます。参考までに。
[hide=DWord型のログを取るクラスと、QWord⇔DWord変換関数の定義]
[code]'DWord型変数のログを記録するクラス
/*
クラス：LogDWord
Dim Obj As LogDWord( ログの記録最大数 )
Obj.Record( ログに保存するDWord型の値 ) ※失敗するとFALSE、成功するとTRUE。普通は成功なので無視してオッケー。
[DWord型変数のログが返る] = Obj.PlayLog( ログのインデックス )
インデックスの範囲は、[古い：0～(最大記録数-1)：新しい]　になります。
*/
Class LogDWord
pDWordArry As DWordPtr
hHeap As HANDLE
nIndex As DWord
nMaxIndex As DWord
Public
Sub LogDWord( nLog As DWord )
hHeap = HeapCreate( NULL, 0, 0 )
pDWordArry = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nLog*SizeOf(DWord) ) As DWordPtr
nIndex = 0
nMaxIndex = nLog
End Sub
Sub ~LogDWord()
HeapDestroy( hHeap )
End Sub

Function Record( nDWord As DWord ) As Long
Dim i As Long

If( pDWordArry=NULL )Then
Record = FALSE
ExitFunction
Else
Record = TRUE
End If

If( nIndex<nMaxIndex )Then
pDWordArry[ nIndex ] = nDWord
nIndex += 1
Else
i = 1
While( i<nIndex )
pDWordArry[ i-1 ] = pDWordArry[ i ]
i += 1
Wend
pDWordArry[ nIndex-1 ] = nDWord
End If
End Function

Function PlayLog( nIndex As DWord ) As DWord
If( nIndex<nMaxIndex )Then
PlayLog = pDWordArry[ nIndex ]
Else
PlayLog = 0
End If
End Function
End Class



'QWord型への変換
Function MakeQWord( LowDWord As DWord, HighDWord As DWord ) As QWord
Dim q As QWord
q = HighDWord
q = q << 32
q = q + LowDWord
MakeQWord = q
EndFunction

'DWord型への分解
Function HiDWord( q As QWord ) As DWord
q = q and &HFFFFFFFF00000000
q = q >> 32
HiDWord = q
EndFunction
Function LoDWord( q As QWord ) As DWord
LoDWord = q and &HFFFFFFFF
EndFunction[/code][/hide]


追記：
えっと。
インクルードファイルを修正＋Fixを使わない方法に変更＋qlをDWord型にする、
でこちらでも正常動作したようです。
10～20分ほど走らせてみましたが、エラーしませんでした。
･･･QWordの除算に関する部分は私の勘違いだったみたいですｍ(_ _)ｍ

> Debugが実行されるトリガーですが、
> これはdwLowDateTimeが[b]Long型変数[/b]の上限（2147483647）を超えたときです。
> （FILETIMEは[b]DWord型変数[/b]で表現されているので、上限4294967295。）

api_system.sbpのなかで、
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
と定義されているためです。

LongをDWordに変更すれば、正常に動作することを確認しました。

OS:windows 2000
AB:4.24

FILETIMEの求め方はあってます。
FILETIMEにバグは無いです。
[color=#aaaaaa]（※精度には私も疑問を持ってますが･･･まぁ、それは刻み幅ではなく絶対値の話なので、ここでは関係ないですね＾＾；）[/color]

Debugが実行されるトリガーですが、
これはdwLowDateTimeが[b]Long型変数[/b]の上限（2147483647）を超えたときです。
（FILETIMEは[b]DWord型変数[/b]で表現されているので、上限4294967295。）

そんなわけで、誤動作の原因はLong型への変換の部分だと
分かったのですが･･･なんでそこがエラーするのかが分かりません（爆）。
Fix関数が怪しいのですが･･･現在調査中です。
以上、途中報告。

忘れてました。

ABは4.13.00
OSはXP　HOME　SP2

宜しくお願いします。

Dim MaeTime As Long	'ｸﾞﾛｰﾊﾞﾙ

SetTimer(hMainWnd,0,100,NULL)	'1000以下なら何でも良い

Sub MainWnd_Timer(TimerID As DWord)
	Dim st As SYSTEMTIME 
    Dim ft As FILETIME
	Dim q As QWord
	Dim ql As Long

    GetLocalTime(st) 
    SystemTimeToFileTime(st, ft) 

    q = ft.dwHighDateTime 
    q = q << 32 
    q = q + ft.dwLowDateTime     '＊

    q = q - &H1C60E664EE94000    '2006年1月1日までのﾌｧｲﾙﾀｲﾑ 引く
    ql = Fix(q / 10000000) As Long 

    If MaeTime = 0 Then 
        MaeTime = ql 
    ElseIf MaeTime-2 < ql and ql < MaeTime+2 Then 
        MaeTime = ql
    Else 
        debug 
    End If

	SetDlgItemText(hMainWnd,Static1,Str$(ql))
End Sub

13771465　前
13771036　今
429　　　　差

13771895　前
13771466　今
429　　　　差

13772754　前
13772325　今
429　　　　差

タイマーイベントに以下のコードを書きました。
見た目に分かり易くする為StaticTextを作っておきます。
FILETIMEを秒単位にしたもの（2006年1月1日からの経過秒）を、ただ表示するだけのコードです。

当然時間なので、1秒毎に1ずつ増えますので、debugが実行される事は永遠に無い様に見えますが、
暫く眺めてると（この長さはランダム）debugに行くことがあります。

これは何故なのでしょう？
バグなのか、そもそも、私のFILETIMEの求め方が違うのか、
元々、FILETIMEはイイカゲンな物なのか。

数値が大きくなるので、分かり易くする為、引いたり、割ったりしていますが
これはFILETIMEがずれる事には関係ないようです。
割る前、引く前（＊マーク）の数値で、自分で確かめました。

FILETIMEの求め方はこの掲示板の過去ログを参考にしました。
http://www.activebasic.com/forum/viewtopic.php?t=256&highlight=%C6%FC%A4%CB%A4%C1

どなたか、この事に関して知っている事や、解決法がありましたら
ぜひ、私に教えてください。宜しくお願いします。

[code]
Dim MaeTime As Long 'ｸﾞﾛｰﾊﾞﾙ

SetTimer(hMainWnd,0,100,NULL) '1000以下なら何でも良い

Sub MainWnd_Timer(TimerID As DWord)
Dim st As SYSTEMTIME
Dim ft As FILETIME
Dim q As QWord
Dim ql As Long

GetLocalTime(st)
SystemTimeToFileTime(st, ft)

q = ft.dwHighDateTime
q = q << 32
q = q + ft.dwLowDateTime '＊

q = q - &H1C60E664EE94000 '2006年1月1日までのﾌｧｲﾙﾀｲﾑ 引く
ql = Fix(q / 10000000) As Long

If MaeTime = 0 Then
MaeTime = ql
ElseIf MaeTime-2 < ql and ql < MaeTime+2 Then
MaeTime = ql
Else
debug
End If

SetDlgItemText(hMainWnd,Static1,Str$(ql))
End Sub
[/code]

何度か調べて見ると、法則性があるようです。
上記コードでは必ず429秒戻ってしまう様です。
偶然なのか、私の環境だけなのか分かりませんが。

[code]
13771465　前
13771036　今
429　　　　差

13771895　前
13771466　今
429　　　　差

13772754　前
13772325　今
429　　　　差
[/code]