Identify a change in computers

  • Thread starter Thread starter Mike
  • Start date Start date
M

Mike

I need to reset some database variables when my program goes on to a
different computer. Is there a way to detect this change. I get can get the
user name via API GetUserName, but many user names are the same (Joe,
Pete...). I can't find an API that will identify a specific computer (like a
serial number).
Any ideas?

thanks
 
See if this helps you:

Option Explicit
Private Declare Function GetVolumeInformation _
Lib "kernel32" _
Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Private Function getDriveVolumeSerial(Optional strDriveLetter As String =
"") As String

'will get the drive serial number
'default is the drive that the application is on
'otherwise can do for example: getDriveSerialNumber("D")
'-------------------------------------------------------

Dim strDrivePath As String
Dim Serial As Long
Dim VName As String
Dim FSName As String

If Len(strDriveLetter) = 0 Then
strDrivePath = Left$(Application.Path, 1) & ":\"
Else
strDrivePath = strDriveLetter & ":\"
End If

'Create buffers
VName = String$(255, Chr$(0))
FSName = String$(255, Chr$(0))

'Get the volume information
GetVolumeInformation strDrivePath, VName, 255, Serial, 0, 0, FSName, 255

getDriveVolumeSerial = Trim(Str$(Abs(Serial)))

End Function


Sub test()

MsgBox getDriveVolumeSerial(), , "HD serial number"

End Sub


RBS
 
Thanks RB. This should do the trick.


RB Smissaert said:
See if this helps you:

Option Explicit
Private Declare Function GetVolumeInformation _
Lib "kernel32" _
Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Private Function getDriveVolumeSerial(Optional strDriveLetter As String =
"") As String

'will get the drive serial number
'default is the drive that the application is on
'otherwise can do for example: getDriveSerialNumber("D")
'-------------------------------------------------------

Dim strDrivePath As String
Dim Serial As Long
Dim VName As String
Dim FSName As String

If Len(strDriveLetter) = 0 Then
strDrivePath = Left$(Application.Path, 1) & ":\"
Else
strDrivePath = strDriveLetter & ":\"
End If

'Create buffers
VName = String$(255, Chr$(0))
FSName = String$(255, Chr$(0))

'Get the volume information
GetVolumeInformation strDrivePath, VName, 255, Serial, 0, 0, FSName,
255

getDriveVolumeSerial = Trim(Str$(Abs(Serial)))

End Function


Sub test()

MsgBox getDriveVolumeSerial(), , "HD serial number"

End Sub


RBS
Click to expand...
 
Or even this combination...

Environ("username") & "/" & Environ("computername")

which uses your suggestion for the computer's name and the non-API method of
getting the user's name.

Rick
 
Yes, maybe better than using the HD serial number as I think that can be the
same when the
disk image has been cloned.

RBS
 
I think it will also change with a reformat (should the user decide to
'clean things up' one day).

Rick
 
Really - we are talking serial number here ?
That's a pain, I just assumed the HD's serial number was somehow embedded
for all eternity, like my car's chassis number. Or is it more akin to my
car's registration number?
I think it will also change with a reformat (should the user decide to
'clean things up' one day).
Click to expand...

Regards,
Peter T
 
Hi Peter,

I think there are 2 different HD numbers. One that is the one you are
interested in and another one
that is obtained with the API I posted. The first one is difficult to get,
but if I remember well there is
a way. Not sure though it can be done with VB(A).

RBS
 
Hi Bart,

You are probably right, looks like I will need to re-think an aspect of my
user validation systems ):-

Regards,
Peter T

"RB Smissaert" wrote in message
 
Actually, getting the real Drive serial number is simple:
http://vbnet.mvps.org/index.html?code/disk/smartide.htm
Click to expand...

Here is another way based on a posting by Larry Serflaten over in the
compiled VB newsgroups...

Insert a Module and copy/paste this code into it...

Public Type HardDriveInfo
DriveLetter As String
VolumeName As String
SerialNumber As String
FormatType As String
TotalSize As String
FreeSize As String
End Type

Public Sub GetDriveInfo(DriveLetter As String, HardDrive As HardDriveInfo)
Dim WMI, SYS, DRV
Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
Set SYS = WMI.ExecQuery("SELECT * FROM Win32_LogicalDisk", "WQL", 48)
For Each DRV In SYS
If StrComp(DRV.Name, Replace(DriveLetter, ":", "") & ":", vbTextCompare)
= 0 Then
With HardDrive
.DriveLetter = DRV.Name
.VolumeName = DRV.VolumeName
.SerialNumber = DRV.VolumeSerialNumber
.FormatType = DRV.FileSystem
.TotalSize = Format(DRV.Size / (10 ^ 6), "#,##0 MB")
.FreeSize = Format(DRV.FreeSpace / (10 ^ 6), "#,##0 MB")
End With
Exit For
End If
Next
End Sub

Now, in your own code, you can declare a variable of type HardDriveInfo,
call the GetDriveInfo subroutine (passing in the drive letter you are
interested in) and retrieve various information about that drive. Here is an
example...

Sub Test()
Dim HD As HardDriveInfo
GetDriveInfo "c", HD
Debug.Print "Drive Letter: " & HD.DriveLetter
Debug.Print "Volume Name: " & HD.VolumeName
Debug.Print "Serial Number: " & HD.SerialNumber
Debug.Print "Drive Format: " & HD.FormatType
Debug.Print "Total Size: " & HD.TotalSize
Debug.Print "Free Size: " & HD.FreeSize
End Sub

Rick
 
"Rick Rothstein (MVP - VB)" wrote in message
Here is another way based on a posting by Larry Serflaten over in the
compiled VB newsgroups...
Click to expand...
Public Sub GetDriveInfo(DriveLetter As String, HardDrive As HardDriveInfo)
Dim WMI, SYS, DRV
Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
Set SYS = WMI.ExecQuery("SELECT * FROM Win32_LogicalDisk", "WQL", 48)
For Each DRV In SYS
Click to expand...
<snip>

Hi Rick,
Another interesting solution. Unfortunately it doesn't work on my W98SE,
though it does in Vista.

Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
err.432
File or classname not found during automation operation

Other things I've tried with "winmgmts" also fail in w9x, including yet
another approach sent to me by RBS off-line. Slightly different error -
Object doesn't support this property or method

By contrast, Randy Birch's code (the RBS link up top) works in W98 but fails
in Vista, I suspect 'cos of this-

Private Function SmartOpen(drvNumber As IDE_DRIVE_NUMBER) As Long

'Open SMART to allow DeviceIoControl
'communications and return SMART handle

If IsWinNT4Plus() Then

SmartOpen = CreateFile("\\.\PhysicalDrive" & CStr(drvNumber), _
GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, _
OPEN_EXISTING, _
0&, _
0&)

Else

SmartOpen = CreateFile("\\.\SMARTVSD", _
0&, 0&, _
ByVal 0&, _
CREATE_NEW, _
0&, _
0&)
End If

End Function

I hope Randy Birch does not mind my posting this function (see link above),
though I've seen virtually the same function in a number of sources. Anyway,
in my Vista SmartOpen returns -1 which in effect is non-valid. FWIW
IsWinNT4Plus returns true but SmartOpen returns -1 with both true/false
variations.

Unless I can get GetObject("winmgmts: etc working for all W98 users, or the
SmartOpen function working for all Vista users, seems I would need radically
different solutions to cater for different OS. Unless of course you have any
more ideas :-)

Regards,
Peter T
 
It's been awhile, but I thought WMI was automatically installed with Win98SE
and up; but, in checking, I see I was wrong, it was WinXP and above. Those
with Win95, Win98 and Win98SE can install WMI individually in order to get
the functionality provided by it. Here is the download site...

http://www.microsoft.com/downloads/...ba-337b-4e92-8c18-a63847760ea5&displaylang=en

If you want to read more about WMI, you can do so at this link...

http://en.wikipedia.org/wiki/Windows_Management_Instrumentation

Rick
 
Thanks for the info and the link. Installing WMI individually is not an
option for my purposes.
I see I was wrong, it was WinXP and above
Click to expand...
Looks like it is shipped with ME and later.

It'd sure be handy though to find a method that returns something akin to a
physical HD serial number that'll work in W98 to Vista.

Regards,
Peter T
 
Here is another way based on a posting by Larry Serflaten over in the
compiled VB newsgroups...

Insert a Module and copy/paste this code into it...

Public Type HardDriveInfo
DriveLetter As String
VolumeName As String
SerialNumber As String
FormatType As String
TotalSize As String
FreeSize As String
End Type

Public Sub GetDriveInfo(DriveLetter As String, HardDrive As HardDriveInfo)
Dim WMI, SYS, DRV
Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
Set SYS = WMI.ExecQuery("SELECT * FROM Win32_LogicalDisk", "WQL", 48)
For Each DRV In SYS
If StrComp(DRV.Name, Replace(DriveLetter, ":", "") & ":", vbTextCompare)
= 0 Then
With HardDrive
.DriveLetter = DRV.Name
.VolumeName = DRV.VolumeName
.SerialNumber = DRV.VolumeSerialNumber
.FormatType = DRV.FileSystem
.TotalSize = Format(DRV.Size / (10 ^ 6), "#,##0 MB")
.FreeSize = Format(DRV.FreeSpace / (10 ^ 6), "#,##0 MB")
End With
Exit For
End If
Next
End Sub

Now, in your own code, you can declare a variable of type HardDriveInfo,
call the GetDriveInfo subroutine (passing in the drive letter you are
interested in) and retrieve various information about that drive. Here is an
example...

Sub Test()
Dim HD As HardDriveInfo
GetDriveInfo "c", HD
Debug.Print "Drive Letter: " & HD.DriveLetter
Debug.Print "Volume Name: " & HD.VolumeName
Debug.Print "Serial Number: " & HD.SerialNumber
Debug.Print "Drive Format: " & HD.FormatType
Debug.Print "Total Size: " & HD.TotalSize
Debug.Print "Free Size: " & HD.FreeSize
End Sub

Rick
Click to expand...

That is a neat way to do this and thanks for posting.
Not sure if it is better, but I would code it slightly different:

Function GetDriveInfo(DriveLetter As String) As HardDriveInfo

Dim WMI
Dim SYS
Dim DRV

Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
Set SYS = WMI.ExecQuery("SELECT * FROM Win32_LogicalDisk", _
"WQL", _
48)

For Each DRV In SYS
If StrComp(DRV.Name, Replace(DriveLetter, ":", "") & ":",
vbTextCompare) = 0 Then
With GetDriveInfo
.DriveLetter = DRV.Name
.VolumeName = DRV.VolumeName
.SerialNumber = DRV.VolumeSerialNumber
.FormatType = DRV.FileSystem
.TotalSize = Format(DRV.Size / (10 ^ 6), "#,##0 MB")
.FreeSize = Format(DRV.FreeSpace / (10 ^ 6), "#,##0 MB")
End With
Exit For
End If
Next

End Function

Sub Test()
Dim HD As HardDriveInfo
HD = GetDriveInfo("S")
Debug.Print "Drive Letter: " & HD.DriveLetter
Debug.Print "Volume Name: " & HD.VolumeName
Debug.Print "Serial Number: " & HD.SerialNumber
Debug.Print "Drive Format: " & HD.FormatType
Debug.Print "Total Size: " & HD.TotalSize
Debug.Print "Free Size: " & HD.FreeSize
End Sub


RBS
 
Here is another way based on a posting by Larry Serflaten over in the
That is a neat way to do this and thanks for posting.
Not sure if it is better, but I would code it slightly different:

Function GetDriveInfo(DriveLetter As String) As HardDriveInfo

Dim WMI
Dim SYS
Dim DRV

Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
Set SYS = WMI.ExecQuery("SELECT * FROM Win32_LogicalDisk", _
"WQL", _
48)

For Each DRV In SYS
If StrComp(DRV.Name, Replace(DriveLetter, ":", "") & ":",
vbTextCompare) = 0 Then
With GetDriveInfo
.DriveLetter = DRV.Name
.VolumeName = DRV.VolumeName
.SerialNumber = DRV.VolumeSerialNumber
.FormatType = DRV.FileSystem
.TotalSize = Format(DRV.Size / (10 ^ 6), "#,##0 MB")
.FreeSize = Format(DRV.FreeSpace / (10 ^ 6), "#,##0 MB")
End With
Exit For
End If
Next

End Function

Sub Test()
Dim HD As HardDriveInfo
HD = GetDriveInfo("S")
Debug.Print "Drive Letter: " & HD.DriveLetter
Debug.Print "Volume Name: " & HD.VolumeName
Debug.Print "Serial Number: " & HD.SerialNumber
Debug.Print "Drive Format: " & HD.FormatType
Debug.Print "Total Size: " & HD.TotalSize
Debug.Print "Free Size: " & HD.FreeSize
End Sub
Click to expand...

Nothing wrong with that approach, of course. I usually reserve function over
subroutine creation when I expect at some point to be able to use a return
value within an expression of some sort (like, for example, a chain set of
function calls). I don't foresee such a usage for this code; hence, the my
choice of the subroutine.

Rick
 
It'd sure be handy though to find a method that returns something akin
to a physical HD serial number that'll work in W98 to Vista.
Click to expand...

I would think you could combine the two methods into a single function
call... a simple If/Then test should be able to bind the two methods
together. Test if the version is less than WinME, then use Randy Birch's
method; otherwise use the method I posted.

Rick
 
Rick Rothstein (MVP - VB) wrote in message
I would think you could combine the two methods into a single function
call... a simple If/Then test should be able to bind the two methods
together. Test if the version is less than WinME, then use Randy Birch's
method; otherwise use the method I posted.

Rick
Click to expand...

Indeed, that would seem the sensible way to cater for all versions.

Thanks,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Formula to fill in fields when cell is blank 2
Data Validation Lists - Generating a list based on another list'sresult 2
comparing data without unique identifier 2
Run Module Code 4
Variable Name Changes in Loop Operation 6
XML API in VBA under Excel? 1
Computer identification using Excel VB 8
Setting Employee Access Levels 3

Back
Top