ab.com コミュニティ

コード: 全て選択

Const SIZE_OF_LONG = 4

Sub MainWnd_CommandButton1_Click()
	Dim CPUUsage As Long
	Dim ValueSize As Long
	Dim hKey As HKEY

	'HKEY_DYN_DATAの“\PerfStats\StartStat\KERNEL\CPUUsage”という値を
	'クエリーすることにより、CPU使用率の計測が開始される。
	ValueSize = SIZE_OF_LONG
	RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_QUERY_VALUE, hKey)
	RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, 0, VarPtr(CPUUsage), VarPtr(ValueSize))
	RegCloseKey(hKey)

	'一秒間計測
	Sleep(1000)
	    
	'実際のCPU使用率は“\PerfStats\StatData\KERNEL\CPUUsage"という値で
	'取得できる。
	ValueSize = SIZE_OF_LONG
	RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, KEY_QUERY_VALUE, hKey)
	RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, 0, VarPtr(CPUUsage), VarPtr(ValueSize))
	RegCloseKey(hKey)

	'計測結果を表示
	dim a[255] as Byte
	wsprintf(a,"%d ％",CPUUsage)
	MsgBox hMainWnd,a,0,MB_OK

	'計測を終了するには、“\PerfStats\StopStat\KERNEL\CPUUsage”という
	'値をクエリーする。
	ValueSize = SIZE_OF_LONG
	RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_QUERY_VALUE, hKey)
	RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, 0, VarPtr(CPUUsage), VarPtr(ValueSize))
	RegCloseKey(hKey)
End Sub

コード: 全て選択

declare function RegConnectRegistry lib "advapi32" alias "RegConnectRegistryA" (lpMachineName As *Char,hKey As HKEY,phkResult As VoidPtr) As Long
declare function RegEnumKeyEx lib "advapi32" alias "RegEnumKeyExA" (hKey As HKEY,dwIndex As DWord,lpName As *Byte,ByRef lpcName As DWord,lpReserved As *DWord,lpClass As *Byte,ByRef lpcClass As DWord,lpftLastWriteTime As *FILETIME) As Long 

const DIFFFLAGLEN=6 
const PERFENUMKEY="System\CurrentControlSet\Control\PerfStats\Enum" 

dim szCounter[MAX_PATH] as Byte 
dim szObject[MAX_PATH] as Byte 
dim szName[MAX_PATH] as Byte 
dim lpszDescBuff=0 as LPSTR 
dim szDiffFlag[DIFFFLAGLEN] as Byte 

Dim szComputerName As String
Dim Size As Long

szComputerName=String$(255,Chr$(0))
Size=Len(szComputerName)
GetComputerName(szComputerName,Size)

RegConnectRegistry(szComputerName,HKEY_LOCAL_MACHINE,VarPtr(hkRemoteMachine))

    DisableDataCollection(szObject,szCounter) 'Destroy イベント内 

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) 
    dim rc as DWord 
    dim dwIndex1 as DWord, dwIndex2 as DWord 
    dim dwType as DWord 
    dim dwBufSize as DWord 
    dim hKey as HKEY 
    dim hObject as HKEY 
    dim hCounter as HKEY 

    rc=RegOpenKeyEx(HKEY_LOCAL_MACHINE,PERFENUMKEY,0,KEY_READ,hKey) 
    if rc=ERROR_SUCCESS then 
        dwBufSize=MAX_PATH 
        dwIndex1=0 

        'オブジェクトを列挙します。 
        while RegEnumKeyEx(hKey,dwIndex1,szObject,dwBufSize,0,0,ByVal 0,0)=ERROR_SUCCESS 
            dwIndex1++ 
            if rc=RegOpenKeyEx(hKey,szObject,0,KEY_READ,hObject)=ERROR_SUCCESS then 
                'hObject を使ってオープン キーの情報を処理します。 
                if rc=RegQueryValueEx(hObject,"Name",0,VarPtr(dwType),szObject,VarPtr(dwBufSize))=ERROR_SUCCESS then 
                    dwIndex2=0 
                    dwBufSize=MAX_PATH 
                    while RegEnumKeyEx(hObject,dwIndex2,szCounter,dwBufSize,0,0,ByVal 0,0)=ERROR_SUCCESS 
                        dwIndex2++ 
                        if rc=RegOpenKeyEx(hObject,szCounter,0,KEY_READ,hCounter)=ERROR_SUCCESS then 
                            'hCounter を使ってオープン カウンタ キーの処理を行います。 

                            '最初は、パフォーマンス カウンタの Name を取得します。 
                            dwBufSize=MAX_PATH 
                            rc=RegQueryValueEx(hObject,"Name",0,VarPtr(dwType),szName,VarPtr(dwBufSize)) 

                            '次に、Description を取得します。 
                            dwBufSize=0 
                            RegQueryValueEx(hCounter,"Description",0,VarPtr(dwType),0,VarPtr(dwBufSize)) 
                            lpszDescBuff=malloc(dwBufSize+1) 
                            rc=RegQueryValueEx(hCounter,"Description",0,VarPtr(dwType),lpszDescBuff,VarPtr(dwBufSize)) 
                            if rc=ERROR_SUCCESS then 
                                dim msg1[255] as Byte 
                                wsprintf(msg1,"%s: %s",szCounter,lpszDescBuff) 
                                MessageBox(hMainWnd,msg1,0,MB_OK) 
                                free(lpszDescBuff) 
                            End If 

                            'Differentiate 値を取得します。 
                            dwBufSize=DIFFFLAGLEN 
                            rc=RegQueryValueEx(hCounter,"Differentiate",0,VarPtr(dwType),szDiffFlag,VarPtr(dwBufSize)) 
                            if rc=ERROR_SUCCESS then 
                                dim msg2[255] as Byte 
                                wsprintf(msg2,"Differentiating Counter: %s",szDiffFlag) 
                                MessageBox(hMainWnd,msg2,0,MB_OK) 
                            End If 
                        Else 
                            dim Err1[255] as Byte 
                            wsprintf(Err1,"Error %d opening counter %s",rc,szCounter) 
                            MessageBox(hMainWnd,Err1,0,MB_OK or MB_ICONEXCLAMATION) 
                        End If 
                        RegCloseKey(hCounter) 
                        dwBufSize=MAX_PATH 
                    Wend 
                End If 
            End If 
            RegCloseKey(hObject) 
            dwBufSize=MAX_PATH 
        Wend 
        RegCloseKey(hKey) 
    Else 
        dim Err3[255] as Byte 
        wsprintf(Err3,"Error %d opening %s",rc,PERFENUMKEY) 
        MessageBox(hMainWnd,Err3,0,MB_OK or MB_ICONSTOP) 
    End If 

	EnableDataCollection(szObject,szCounter)
	CollectPerfData(szObject,szCounter,szName)
End Sub

コード: 全て選択

declare function RegEnumKeyEx lib "advapi32" alias "RegEnumKeyExA" (hKey As HKEY,dwIndex As DWord,lpName As *Byte,ByRef lpcName As DWord,lpReserved As *DWord,lpClass As *Byte,ByRef lpcClass As DWord,lpftLastWriteTime As *FILETIME) As Long

const DIFFFLAGLEN=6
const PERFENUMKEY="System\CurrentControlSet\Control\PerfStats\Enum"

dim szCounter[MAX_PATH] as Byte
dim szObject[MAX_PATH] as Byte
dim szName[MAX_PATH] as Byte
dim lpszDescBuff=0 as LPSTR
dim szDiffFlag[DIFFFLAGLEN] as Byte

	DisableDataCollection(szObject,szCounter) 'Destroy イベント内

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	dim rc as DWord
	dim dwIndex1 as DWord, dwIndex2 as DWord
	dim dwType as DWord
	dim dwBufSize as DWord
	dim hKey as HKEY
	dim hObject as HKEY
	dim hCounter as HKEY

	rc=RegOpenKeyEx(HKEY_LOCAL_MACHINE,PERFENUMKEY,0,KEY_READ,hKey)
	if rc=ERROR_SUCCESS then
		dwBufSize=MAX_PATH
		dwIndex1=0

		'オブジェクトを列挙します。
		while RegEnumKeyEx(hKey,dwIndex1,szObject,dwBufSize,0,0,ByVal 0,0)=ERROR_SUCCESS
			dwIndex1++
			if rc=RegOpenKeyEx(hKey,szObject,0,KEY_READ,hObject)=ERROR_SUCCESS then
				'hObject を使ってオープン キーの情報を処理します。
				if rc=RegQueryValueEx(hObject,"Name",0,VarPtr(dwType),szObject,VarPtr(dwBufSize))=ERROR_SUCCESS then
					dwIndex2=0
					dwBufSize=MAX_PATH
					while RegEnumKeyEx(hObject,dwIndex2,szCounter,dwBufSize,0,0,ByVal 0,0)=ERROR_SUCCESS
						dwIndex2++
						if rc=RegOpenKeyEx(hObject,szCounter,0,KEY_READ,hCounter)=ERROR_SUCCESS then
							'hCounter を使ってオープン カウンタ キーの処理を行います。

							'最初は、パフォーマンス カウンタの Name を取得します。
							dwBufSize=MAX_PATH
							rc=RegQueryValueEx(hObject,"Name",0,VarPtr(dwType),szName,VarPtr(dwBufSize))

							'次に、Description を取得します。
							dwBufSize=0
							RegQueryValueEx(hCounter,"Description",0,VarPtr(dwType),0,VarPtr(dwBufSize))
							lpszDescBuff=malloc(dwBufSize+1)
							rc=RegQueryValueEx(hCounter,"Description",0,VarPtr(dwType),lpszDescBuff,VarPtr(dwBufSize))
							if rc=ERROR_SUCCESS then
								dim msg1[255] as Byte
								wsprintf(msg1,"%s: %s",szCounter,lpszDescBuff)
								MessageBox(hMainWnd,msg1,0,MB_OK)
								free(lpszDescBuff)
							End If

							'Differentiate 値を取得します。
							dwBufSize=DIFFFLAGLEN
							rc=RegQueryValueEx(hCounter,"Differentiate",0,VarPtr(dwType),szDiffFlag,VarPtr(dwBufSize))
							if rc=ERROR_SUCCESS then
								dim msg2[255] as Byte
								wsprintf(msg2,"Differentiating Counter: %s",szDiffFlag)
								MessageBox(hMainWnd,msg2,0,MB_OK)
							End If
						Else
							dim Err1[255] as Byte
							wsprintf(Err1,"Error %d opening counter %s",rc,szCounter)
							MessageBox(hMainWnd,Err1,0,MB_OK or MB_ICONEXCLAMATION)
						End If
						RegCloseKey(hCounter)
						dwBufSize=MAX_PATH
					Wend
				End If
			End If
			RegCloseKey(hObject)
			dwBufSize=MAX_PATH
		Wend
		RegCloseKey(hKey)
	Else
		dim Err3[255] as Byte
		wsprintf(Err3,"Error %d opening %s",rc,PERFENUMKEY)
		MessageBox(hMainWnd,Err3,0,MB_OK or MB_ICONSTOP)
	End If
End Sub

コード: 全て選択

function EnableDataCollection(szObjName As Byte,szCounterName As Byte) As Long
	dim hOpen as HKEY
	dim cbData as DWord
	dim dwType as DWord
	dim pByte as BytePtr
	dim rc as DWord
	dim szCounterData as char
	dim bSuccess=TRUE as long
	
	if rc=RegOpenKeyEx(HKEY_DYN_DATA,"PerfStats\StartStat",0,KEY_READ,hOpen)=ERROR_SUCCESS then
		'オブジェクトとカウンタ キー名を連結します。
		szCounterData=malloc(lstrlen(szObjName)+lstrlen(szCounterName)+2)
		wsprintf(szCounterData,"%s\%s",szObjName,szCounterName)
		SetDlgItemText(hMainWnd,Static1,szCounterData)

		'データ サイズを検索します。
		if rc=RegQueryValueEx(hOpen,szCounterData,0,VarPtr(dwType),0,VarPtr(cbData))=ERROR_SUCCESS then
			pByte=LocalAlloc(VoidPtr,cbData)

			'パフォーマンス スタート キーを検索し、パフォーマンス データを
			'初期化します。
			'スタート キーを検索し、パフォーマンス データを初期化します。
			rc=RegQueryValueEx(hOpen,szCounterData,0,VarPtr(dwType),pByte,VarPtr(cbData))
			'この時点では、データに関するものは何もありません。
			'リソースを開放します。
			free(pByte)
		Else
			bSuccess=FALSE
		End If
		RegCloseKey(hOpen)
		LocalFree(szCounterData)
	Else
		bSuccess=FALSE
	End If
	EnableDataCollection=bSuccess
End Function

function CollectPerfData(szObjName As *Char,szCounterName As *Char,pdwData As DWord) As Long
	dim hOpen as HKEY
	dim dwType as DWord
	dim cbData as DWord
	dim szCounterData as *char
	dim rc as DWord
	dim bSuccess=TRUE as long

	'オブジェクトとカウンタ キーを連結します。
	szCounterData=malloc(lstrlen(szObjName)+lstrlen(szCounterName)+2)
	wsprintf(szCounterData,"%s\%s",szObjName,szCounterName)
	SetDlgItemText(hMainWnd,Static1,szCounterData)

	'パフォーマンス データ キーをオープンします。
	if rc=RegOpenKeyEx(HKEY_DYN_DATA,"PerfStats\StatData",0,KEY_READ,hOpen)=ERROR_SUCCESS then
		cbData=SizeOf(DWord)
		'サイズが DWORD のパフォーマンス データを取得します。
		rc=RegQueryValueEx(hOpen,szCounterData,0,VarPtr(dwType),pdwData,VarPtr(cbData))

		'呼び出し側に処理状態を知らせます。
		rc=ERROR_SUCCESS
		bSuccess=rc
		RegCloseKey(hOpen)
	Else
		bSuccess=FALSE
	End If

	'リソースを開放します。
	free(szCounterData)
	CollectPerfData=bSuccess
End Function

function DisableDataCollection(szObjName As *Char,szCounterName As *Char) As Long
	dim hOpen as HKEY
	dim pByte as BytePtr
	dim cbData as DWord
	dim dwType as DWord
	dim rc as DWord
	dim szCounterData as *char
	dim bSuccess=TRUE as long
	
	if rc=RegOpenKeyEx(HKEY_DYN_DATA,"PerfStats\StopStat",0,KEY_READ,hOpen)=ERROR_SUCCESS then
		'オブジェクトとカウンタ キー名を連結します。
		szCounterData=malloc(lstrlen(szObjName)+lstrlen(szCounterName)+2)
		wsprintf(szCounterData,"%s\%s",szObjName,szCounterName)

		'検索をかけてデータ サイズを取得します。
		if rc=RegQueryValueEx(hOpen,szCounterData,0,VarPtr(dwType),0,VarPtr(cbData))=ERROR_SUCCESS then
			pByte=malloc(cbData)

			'パフォーマンス スタート キーを検索し、パフォーマンス データを
			'初期化します。
			'スタート キーを検索し、パフォーマンス データを初期化します。
			rc=RegQueryValueEx(hOpen,szCounterData,0,VarPtr(dwType),pByte,VarPtr(cbData))
			'この時点では、データに関するものは何もありません。
			'リソースを開放します。
			free(pByte)
		Else
			bSuccess=FALSE
		End If
		RegCloseKey(hOpen)
		free(szCounterData)
	Else
		bSuccess=FALSE
	End If
	DisableDataCollection=bSuccess
End Function