Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Processor Speed 1

Status
Not open for further replies.

rekclaw

Programmer
Jun 27, 2000
47
US
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?

Thanks

rekclaw
 
Hi,

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

Call RegOpenKey(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", hKey)
Call RegQueryValueEx(hKey, "~MHz", 0, 0, lSpeed, 4)
Call RegCloseKey(hKey)

GetCPUSpeed = lSpeed
End Function
[/tt]

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.

LuCkY
 
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.

Thanks

Rekclaw
 
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), &quot;\&quot;, lPointer, lLength)
Call MoveMemory(vffi, ByVal lPointer, lLength)
sBrowserVersion = Trim(CStr(HIWORD(vffi.dwFileVersionMS))) & &quot;.&quot; & Trim(CStr(LOWORD(vffi.dwFileVersionMS))) & &quot;.&quot; & Trim(CStr(HIWORD(vffi.dwFileVersionLS))) & &quot;.&quot; & 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(&quot;00000000&quot; & Hex(dwValue), 8)
HIWORD = CLng(&quot;&H&quot; & Left(hexstr, 4))
End Function

Private Function LOWORD(ByVal dwValue As Long) As Long
Dim hexstr As String
hexstr = Right(&quot;00000000&quot; & Hex(dwValue), 8)
LOWORD = CLng(&quot;&H&quot; & Right(hexstr, 4))
End Function[/tt]

LuCkY
 
Luke,

Your Awesome!!!

Thanks a bunch!

Rekclaw
 
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;

QueryPerformanceFrequency((LARGE_INTEGER *)&nFreq);

__asm // inline assembly code block
{
_emit 0x0F
_emit 0x31
mov DWORD PTR start, eax
mov DWORD PTR [start+4], edx
}

QueryPerformanceCounter((LARGE_INTEGER *)&nCtrStop);

nCtrStop += nFreq;

do
QueryPerformanceCounter((LARGE_INTEGER *)&nCtr);
while (nCtr < nCtrStop);

__asm // inline assembly code block
{
_emit 0x0F
_emit 0x31
mov DWORD PTR stop, eax
mov DWORD PTR [stop+4], edx
}

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 &quot;auditdll.dll&quot; (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 &quot;Processor Clock Speed: &quot; & _
CLng((ULargeToCurrency(Hz) / 1000000)) & &quot; MHz&quot;
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

CopyMemory cTemp, ULarge, BITS_IN_BYTE

ULargeToCurrency = cTemp * DECIMAL_POINT_OFFSET

End Function
////// End of VB Code //////
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top