ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2018年8月15日(水) 13:47

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 2 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年10月08日(土) 21:20 
オフライン

登録日時: 2005年5月31日(火) 17:59
記事: 895
住所: 東京都
Windowsが起動してからの時間をレジストリから調べて64ビット値で得るプログラムです。
実はネットで検索して見つけたプログラムをABに移植しただけで自分でもあまり理解していなかったりします。
秒未満の単位で格納されているので、1844(中略)1616秒まで対応しているわけではありませんが、少なくとも万年くらいは平気でしょう。
(注意:おそらくNT系限定だと思われます)
コード:
#strict
Dim Second As QWord, Min As DWord, Hour As DWord, Day As DWord
Second = GetTickCount64()

Day = (Second \ 86400) As DWord
Second = Second - Day * 86400

Hour = (Second \ 3600) As DWord
Second = Second - Hour * 3600

Min = (Second \ 60) As DWord
Second = Second - Min * 60

Dim Str[1024] As Byte
wsprintf(Str, "%u日 %u時間 %u分 %u秒", Day, Hour, Min, Second As DWord)
MessageBox(0, Str, "起動してから", MB_OK)

Class TempMemory '即席
Public
	Sub TempMemory()(AllocSize As DWord)
		size = AllocSize
		ptr = malloc(size)
	End Sub

	Sub ~TempMemory()
		If ptr <> 0 Then free(ptr)
	End Sub

	Function Ptr() As *Byte
		Ptr = ptr
	End Function

	Function Size() As DWord
		Size = size
	End Function

	Sub ReSize(NewSize As DWord)
		ptr = realloc(ptr, NewSize)
	End Sub
Private
	ptr As *Byte
	size As DWord
End Class

Type PERF_DATA_BLOCK
	Signature[ELM(4)] As WCHAR
	LittleEndian As DWord
	Version As DWord
	Revision As DWord
	TotalByteLength As DWord
	HeaderLength As DWord
	NumObjectTypes As DWord
	DefaultObject As DWord
	SystemTime As SYSTEMTIME
Private
	dammy0 As DWord
Public
	PerfTime As QWord
	PerfFreq As QWord
	PerfTime100nSec As QWord
	SystemNameLength As DWord
	SystemNameOffset As DWord
End Type

Type PERF_OBJECT_TYPE
	TotalByteLength As DWord
	DefinitionLength As DWord
	HeaderLength As DWord
	ObjectNameTitleIndex As DWord
	ObjectNameTitle As *WCHAR
	ObjectHelpTitleIndex As DWord
	ObjectHelpTitle As *WCHAR
	DetailLevel As DWord
	NumCounters As DWord
	DefaultCounter As DWord
	NumInstances As DWord
	CodePage As DWord
	PerfTime As QWord
	PerfFreq As QWord
End Type

Type PERF_COUNTER_DEFINITION
	ByteLength As DWord
	CounterNameTitleIndex As DWord
	CounterNameTitle As *WCHAR
	CounterHelpTitleIndex As DWord
	CounterHelpTitle As *WCHAR
	DefaultScale As DWord
	DetailLevel As DWord
	CounterType As DWord
	CounterSize As DWord
	CounterOffset As DWord
End Type

Const ERROR_MORE_DATA = 234

Function GetTickCount64() As QWord
	Dim pPerfData = 0 As *PERF_DATA_BLOCK
	Dim getSize As DWord
	Dim lError = ERROR_MORE_DATA As Long
	Dim Buffer As TempMemory(1024)
	If Buffer.Ptr() = 0 Then
		Exit Function
	End If
	
	'取れるまで領域を増やしつつ繰り返す
	Do
		getSize = Buffer.Size()
		Dim hKey = HKEY_PERFORMANCE_DATA As HKEY
		lError = RegQueryValueEx(hKey, "2", 0, 0, Buffer.Ptr() As VoidPtr, VarPtr(getSize))
		If lError <> 0 And lError <> ERROR_MORE_DATA Then
			Exit Function
		End If
		pPerfData = Buffer.Ptr() As *PERF_DATA_BLOCK
		If getSize > 0 And memcmp(pPerfData->Signature, Ex"P\0E\0R\0F\0", 8) = 0 Then
			Exit Do
		End If

		If Buffer.Size() > 65536 Then
			Exit Do
		End If
		Buffer.ReSize(Buffer.Size() + 1024)
	Loop While lError = ERROR_MORE_DATA

	If pPerfData->NumObjectTypes = 0 Then
		Exit Function
	End If

	Dim offset As DWord
	offset = pPerfData->HeaderLength
	Dim pObj As *PERF_OBJECT_TYPE
	pObj = (Buffer.Ptr() + offset) As *PERF_OBJECT_TYPE
	offset = offset + pObj->HeaderLength
	Dim pDef As *PERF_COUNTER_DEFINITION 
	pDef = (Buffer.Ptr() + offset) As *PERF_COUNTER_DEFINITION
	Dim pDefUptime = 0 As *PERF_COUNTER_DEFINITION

	Dim i As DWord
	For i = 0 To pObj->NumCounters
		If pDef->CounterNameTitleIndex = 674 Then
			pDefUptime = pDef
			Exit For
		End If
		offset = offset + pDef->ByteLength
		pDef = (Buffer.Ptr() + offset) As *PERF_COUNTER_DEFINITION
	Next

	If pDefUptime = 0 Then
		Exit Function
	End If


	Dim Time As QWord
	memcpy(VarPtr(Time), pObj As *Byte + pObj->DefinitionLength + pDefUptime->CounterOffset, SizeOf (QWord))

	GetTickCount64 = (pObj->PerfTime - Time) / pObj->PerfFreq
End Function


通報する
ページトップ
 記事の件名: 遅くなりました
投稿記事Posted: 2005年10月13日(木) 19:58 
オフライン

登録日時: 2005年5月31日(火) 23:46
記事: 45
住所: 愛知県
すみません遅くなりました。

いろいろいじってみたのですが、うまく動いてくれません。
全て0になってしまいます。

環境は稼業時間37日のパソコン(XP Home,AB4.1001)です。

どこをいじればよいのかもよくわかりません。すみません。


通報する
ページトップ
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 2 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke