ab.com コミュニティ https://www.activebasic.com/forum/ |
|
64ビット版GetTickCount関数 https://www.activebasic.com/forum/viewtopic.php?t=377 |
ページ 1 / 1 |
作成者: | イグトランス [ 2005年10月08日(土) 21:20 ] |
記事の件名: | 64ビット版GetTickCount関数 |
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 |
作成者: | ケースケ [ 2005年10月13日(木) 19:58 ] |
記事の件名: | 遅くなりました |
すみません遅くなりました。 いろいろいじってみたのですが、うまく動いてくれません。 全て0になってしまいます。 環境は稼業時間37日のパソコン(XP Home,AB4.1001)です。 どこをいじればよいのかもよくわかりません。すみません。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |