I have a need to retrieve the clock speed of the processor from VB. Anybody have any suggestions? And as long as I'm asking for cool API calls, does anyone know how to retrieve the currently installed browser and its version info?
I don't know if there's a API call for it, but its stored in the registry for sure:
[tt]
Private Declare Function RegCloseKey Lib "advapi32" _
(ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32" _
Alias "RegOpenKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long
Private Function GetCPUSpeed() As Long
Dim hKey As Long
Dim lSpeed As Long
As for the browser, it might not be the nicest way to do it, but its the only thing i can imagine at the moment Anyway create a temporarily html file and use the FindExecutable API call on that file to get the default browser and the FileVersionInfo API call to retrieve the version of the exe.
Thanks Luke! This helped a lot. I'm having trouble with GetFileVersionInfo, though. Got any examples on using this API function. I'm pretty sure the problem is with the last paramater that is looking for a pointer to an "Any" data type.
Ok, it is not an easy function to use I just found out Anyway, I got it fixed, here is the code to get the path to the default browser and the version of it, so it wont return the actual name. I don't really know how to do this, you might do it by reading the file description, but I don't know if all browsers have stored it somewhere in the file or in the description or wherever it might be. Perhaps even the default browser is listed in the registry? Anyway, working code is below:
[tt]Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersion As Long
dwFileVersionMS As Long
dwFileVersionLS As Long
dwProductVersionMS As Long
dwProductVersionLS As Long
dwFileFlagsMask As Long
dwFileFlags As Long
dwFileOS As Long
dwFileType As Long
dwFileSubtype As Long
dwFileDateMS As Long
dwFileDateLS As Long
End Type
Private Sub Form_Load()
Dim sPath As String
Dim sVersion As String
Call GetBrowserInformation(sPath, sVersion)
MsgBox "The default browser on this computer is " & sPath & " " & sVersion
End Sub
Private Sub GetBrowserInformation(ByRef sBrowserPath As String, ByRef sBrowserVersion As String)
Const sPath As String = "temp.html"
Dim sBuffer As String
Dim bBuffer() As Byte
Dim lPointer As Long
Dim lLength As Long
Dim lReturn As Long
Dim vffi As VS_FIXEDFILEINFO
Open sPath For Output As #1
Close #1
sBuffer = Space$(256)
If FindExecutable(sPath, vbNullString, sBuffer) < 33 Then
'error
Else
sBuffer = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1)
sBrowserPath = sBuffer
lReturn = GetFileVersionInfoSize(sBuffer, 0&)
If lReturn < 1 Then
'error
Else
ReDim bBuffer(lReturn - 1)
Call GetFileVersionInfo(sBuffer, 0&, lReturn, bBuffer(0))
Call VerQueryValue(bBuffer(0), "\", lPointer, lLength)
Call MoveMemory(vffi, ByVal lPointer, lLength)
sBrowserVersion = Trim(CStr(HIWORD(vffi.dwFileVersionMS))) & "." & Trim(CStr(LOWORD(vffi.dwFileVersionMS))) & "." & Trim(CStr(HIWORD(vffi.dwFileVersionLS))) & "." & Trim(CStr(LOWORD(vffi.dwFileVersionLS)))
End If
End If
Kill sPath
End Sub
Private Function HIWORD(ByVal dwValue As Long) As Long
Dim hexstr As String
hexstr = Right("00000000" & Hex(dwValue), 8)
HIWORD = CLng("&H" & Left(hexstr, 4))
End Function
Private Function LOWORD(ByVal dwValue As Long) As Long
Dim hexstr As String
hexstr = Right("00000000" & Hex(dwValue), 8)
LOWORD = CLng("&H" & Right(hexstr, 4))
End Function[/tt]
You can only get the clock speed of the processor from the Registry if you're using an NT based system, such as NT4, 2000 or XP.
You would need to use C++ with inline assembly code to calculate the clock speed. This can't be done in VB directly.
I found an excellent example on Planet Source Code of how to do this. I just put it into a Visual C++ DLL and called it from VB.
It works on most processors, although it caused an Invalid Instruction Fault on my girlfriend's old 486.
Here's the code for the DLL function, followed by the VB code for calling the DLL:
////// Start of Visual C++ Code //////
AUDITDLLEXIM long _stdcall GetProcessorClockSpeed(ULARGE_INTEGER &Hz)
{
unsigned __int64 start, stop;
unsigned __int64 nCtr, nFreq, nCtrStop;
Hz.QuadPart = (stop-start); // populate the 64bit part of the pointer
if ( Hz.QuadPart > 0 )
return 1;
else
return 0;
}
////// End of Visual C++ Code //////
////// Start of VB Code //////
Private Declare Function GetProcessorClockSpeed _
Lib "auditdll.dll" (ByRef Hertz As ULARGE_INTEGER) As Long
Private Type ULARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private Sub CallGetProcessorClockSpeed()
Dim Hz As ULARGE_INTEGER
Dim lRes As Long
lRes = GetProcessorClockSpeed(Hz)
If lRes = 0 Then
Print Err.LastDllError
Else
Print "Processor Clock Speed: " & _
CLng((ULargeToCurrency(Hz) / 1000000)) & " MHz"
End If
End Sub
Private Function ULargeToCurrency(ULarge As ULARGE_INTEGER) As Currency
'// Receives: ULARGE_INTEGER structure which represents a 64 bit number
'// Processes: copies the 64 bit number into a Currency type variable, but _
this results in the loss of 5 decimal places, so multiplies it by 10000
'// Returns: the Currency value
Const BITS_IN_BYTE As Long = 8
Const DECIMAL_POINT_OFFSET As Long = 10000
Dim cTemp As Currency
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.