This code is for identifying a computer. It returns a number corresponding to that Motherboard/Processor/NetworkAdapter
And it also returns a number for each disk.
The functions are: GetComputerIDNumber, GetDiskCount and GetDiskIDNumber(i)
mComputerID bas module code:
Code:
Option Explicit
Private Declare Function RoGetActivationFactory Lib "combase" (ByVal activatableClassId As Long, rIID As Any, lpFactory As Any) As Long
Private Declare Function WindowsCreateString Lib "combase" (ByVal sourceString As Long, ByVal length As Long, hString As Long) As Long
Private Declare Function WindowsDeleteString Lib "combase" (ByVal hString As Long) As Long
Private Declare Function WindowsGetStringRawBuffer Lib "combase" (ByVal hString As Long, length As Long) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpString As Long, rIID As Any) As Long
Private Declare Function SysReAllocString Lib "oleaut32" Alias "#3" (ByVal pBSTR As Long, ByVal pStr As Long) As Long
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgvt As Any, prgpvarg As Any, pvargResult As Variant) As Long
Private Declare Function HashDataAny Lib "shlwapi" Alias "HashData" (ByVal pbData As Long, ByVal cbData As Long, ByRef pbHash As Any, ByVal cbHash As Long) As Long
Private IID_ISystemIdentificationStatics(0 To 3) As Long
Private IID_ICryptographicBufferStatics(0 To 3) As Long
Private Declare Function GetSystemFirmwareTable Lib "kernel32" (ByVal FirmwareTableProviderSignature As Long, ByVal FirmwareTableID As Long, FirmwareTableBuffer As Any, ByVal BufferSize As Long) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (uGUID As Any, ByVal lpSz As Long, ByVal cchMax As Long) As Long
Private Const NCBASTAT As Long = &H33
Private Const NCBRESET As Long = &H32
Private Const NCBENUM As Long = &H37
Private Const NRC_GOODRET As Long = &H0
Private Const MAX_LANA As Long = 254
Private Const NCBNAMSZ As Long = 16
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4
Private Type LANA_ENUM
length As Byte
adapter_numbers(0 To MAX_LANA) As Byte 'lanas in range 0 to MAX_LANA inclusive
End Type
Private Type NET_CONTROL_BLOCK 'NCB
ncb_command As Byte
ncb_retcode As Byte
ncb_lsn As Byte
ncb_num As Byte
ncb_buffer As Long
ncb_length As Integer
ncb_callname As String * NCBNAMSZ
ncb_name As String * NCBNAMSZ
ncb_rto As Byte
ncb_sto As Byte
ncb_post As Long
ncb_lana_num As Byte
ncb_cmd_cplt As Byte
ncb_reserve(0 To 9) As Byte 'if Win64, make (0 to 17)
ncb_event As Long
End Type
Private Type ADAPTER_STATUS
adapter_address(0 To 5) As Byte '6 elements
rev_major As Byte
reserved0 As Byte
adapter_type As Byte
rev_minor As Byte
duration As Integer
frmr_recv As Integer
frmr_xmit As Integer
iframe_recv_err As Integer
xmit_aborts As Integer
xmit_success As Long
recv_success As Long
iframe_xmit_err As Integer
recv_buff_unavail As Integer
t1_timeouts As Integer
ti_timeouts As Integer
Reserved1 As Long
free_ncbs As Integer
max_cfg_ncbs As Integer
max_ncbs As Integer
xmit_buf_unavail As Integer
max_dgram_size As Integer
pending_sess As Integer
max_cfg_sess As Integer
max_sess As Integer
max_sess_pkt_size As Integer
name_count As Integer
End Type
Private Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type
Private Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(0 To 30) As NAME_BUFFER
End Type
Private Declare Function Netbios Lib "netapi32.dll" (pncb As NET_CONTROL_BLOCK) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private mDiskInfoRetrieved As Boolean
Private mDiskCount As Long
Private mDiskIDString() As String
'from https://www.vbforums.com/showthread.php?905201-Identify-computer&p=5648565&viewfull=1#post5648565
Private Function GetSystemIdentificationInfo2(Optional lSource As Long) As String
Const SystemIdentification As String = "Windows.System.Profile.SystemIdentification"
Const SystemIdentificationInfo As String = "Windows.System.Profile.SystemIdentificationInfo"
Const CryptographicBuffer As String = "Windows.Security.Cryptography.CryptographicBuffer"
Const IDX_GetSystemIdForPublisher As Long = 6
Const IDX_GetId As Long = 6
Const IDX_GetSource As Long = 7
Const IDX_EncodeToHexString As Long = 12
Dim pSysIdent As stdole.IUnknown
Dim pInfo As stdole.IUnknown
Dim pId As stdole.IUnknown
Dim pCryptoBuf As stdole.IUnknown
Dim hString As Long
Dim hResult As Long
Dim sApiSource As String
On Error GoTo EH
If IID_ISystemIdentificationStatics(0) = 0 Then
Call IIDFromString(StrPtr("{5581F42A-D3DF-4D93-A37D-C41A616C6D01}"), IID_ISystemIdentificationStatics(0))
Call IIDFromString(StrPtr("{320B7E22-3CB0-4CDF-8663-1D28910065EB}"), IID_ICryptographicBufferStatics(0))
End If
'--- auto id = Windows::System::Profile::SystemIdentification::GetSystemIdForPublisher()->Id
Set pSysIdent = CreateFactory(SystemIdentification, IID_ISystemIdentificationStatics(0))
If pSysIdent Is Nothing Then
GoTo QH
End If
hResult = DispCallByVtbl(pSysIdent, IDX_GetSystemIdForPublisher, VarPtr(pInfo))
If hResult < 0 Then
sApiSource = SystemIdentification & ".GetSystemIdForPublisher"
GoTo QH
End If
hResult = DispCallByVtbl(pInfo, IDX_GetId, VarPtr(pId))
If hResult < 0 Then
sApiSource = SystemIdentificationInfo & ".GetId"
GoTo QH
End If
hResult = DispCallByVtbl(pInfo, IDX_GetSource, VarPtr(lSource))
If hResult < 0 Then
sApiSource = SystemIdentificationInfo & ".GetSource"
GoTo QH
End If
'--- auto asHex = Windows::Security::Cryptography::CryptographicBuffer::EncodeToHexString(id)
Set pCryptoBuf = CreateFactory(CryptographicBuffer, IID_ICryptographicBufferStatics(0))
If pCryptoBuf Is Nothing Then
GoTo QH
End If
hResult = DispCallByVtbl(pCryptoBuf, IDX_EncodeToHexString, ObjPtr(pId), VarPtr(hString))
If hResult < 0 Then
sApiSource = CryptographicBuffer & ".EncodeToHexString"
GoTo QH
End If
Call SysReAllocString(VarPtr(GetSystemIdentificationInfo2), WindowsGetStringRawBuffer(hString, 0))
QH:
If hString <> 0 Then
hString = WindowsDeleteString(hString)
End If
If LenB(sApiSource) <> 0 Then
Err.Raise hResult, sApiSource
End If
Exit Function
EH:
hResult = Err.Number
sApiSource = Err.Source
Resume QH
End Function
Private Function CreateFactory(sClassID As String, rIID As Long) As stdole.IUnknown
Dim hString As Long
Dim hResult As Long
Dim sApiSource As String
On Error GoTo EH
hResult = WindowsCreateString(StrPtr(sClassID), Len(sClassID), hString)
If hResult < 0 Then
sApiSource = "WindowsCreateString"
GoTo QH
End If
hResult = RoGetActivationFactory(hString, rIID, CreateFactory)
If hResult < 0 Then
sApiSource = "RoGetActivationFactory"
GoTo QH
End If
QH:
If hString <> 0 Then
hString = WindowsDeleteString(hString)
End If
If LenB(sApiSource) <> 0 Then
Err.Raise hResult, sApiSource
End If
Exit Function
EH:
hResult = Err.Number
sApiSource = Err.Source
Resume QH
End Function
Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
Const CC_STDCALL As Long = 4
Dim lIdx As Long
Dim vParam() As Variant
Dim vType(0 To 63) As Integer
Dim vPtr(0 To 63) As Long
Dim hResult As Long
vParam = A
For lIdx = 0 To UBound(vParam)
vType(lIdx) = VarType(vParam(lIdx))
vPtr(lIdx) = VarPtr(vParam(lIdx))
Next
hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
If hResult < 0 Then
Err.Raise hResult, "DispCallFunc"
End If
End Function
' from https://www.vbforums.com/showthread.php?905201-Identify-computer&p=5648193&viewfull=1#post5648193
Private Function GetMachineUUID(Optional Error As String) As String
Const LNG_RSMB As Long = &H52534D42 '-- "RSMB"
Dim lSize As Long
Dim baBuffer() As Byte
Dim lIdx As Long
Dim lOffset As Long
lSize = GetSystemFirmwareTable(LNG_RSMB, 0, ByVal 0, 0)
ReDim baBuffer(0 To lSize) As Byte
If GetSystemFirmwareTable(LNG_RSMB, 0, baBuffer(0), lSize) <> lSize Then
Error = "Failed GetSystemFirmwareTable"
GoTo QH
End If
lIdx = 8
Do While lIdx < lSize - 16
If baBuffer(lIdx) = 1 Then
lOffset = lIdx + 8
Exit Do
End If
lIdx = lIdx + baBuffer(lIdx + 1)
Do While baBuffer(lIdx) <> 0 Or baBuffer(lIdx + 1) <> 0
lIdx = lIdx + 1
Loop
lIdx = lIdx + 2
Loop
If lOffset = 0 Then
Error = "Cannot find UUID in raw data"
GoTo QH
End If
GetMachineUUID = Space$(38)
Call StringFromGUID2(baBuffer(lOffset), StrPtr(GetMachineUUID), Len(GetMachineUUID) + 1)
QH:
End Function
' from http://vbnet.mvps.org/index.html?code/network/netbiosenumlana.htm
Private Function GetNBMacAddresses(sMACAddresses() As String, sDelimiter As String) As Long
Dim cnt As Long
Dim pASTAT As Long
Dim buff As String
Dim lana As LANA_ENUM 'enum values
Dim ncb As NET_CONTROL_BLOCK
Dim ast As ASTAT
With ncb
.ncb_command = NCBENUM
.ncb_length = LenB(lana)
.ncb_buffer = VarPtr(lana)
End With
Call Netbios(ncb)
If ncb.ncb_retcode = NRC_GOODRET Then
ReDim sMACAddresses(0 To lana.length - 1)
For cnt = 0 To lana.length - 1
With ncb
.ncb_command = NCBRESET
.ncb_lana_num = lana.adapter_numbers(cnt)
End With
Call Netbios(ncb)
If ncb.ncb_retcode = NRC_GOODRET Then
With ncb
.ncb_command = NCBASTAT
.ncb_lana_num = lana.adapter_numbers(cnt)
.ncb_length = Len(ast)
.ncb_callname = Space$(16)
Mid$(.ncb_callname, 1, 1) = "*"
End With
pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, ncb.ncb_length)
If pASTAT <> 0 Then
ncb.ncb_buffer = pASTAT
Call Netbios(ncb)
If ncb.ncb_retcode = NRC_GOODRET Then
CopyMemory ast, ncb.ncb_buffer, Len(ast)
sMACAddresses(cnt) = MakeMacAddress(ast.adapt.adapter_address(), sDelimiter)
HeapFree GetProcessHeap(), 0, pASTAT
End If
End If
End If
Next
GetNBMacAddresses = lana.length
End If
End Function
Private Function MakeMacAddress(b() As Byte, sDelim As String) As String
Dim cnt As Long
Dim buff As String
On Local Error GoTo MakeMac_error
If UBound(b) = 5 Then
For cnt = 0 To 4
buff = buff & Right$("00" & Hex(b(cnt)), 2) & sDelim
Next
buff = buff & Right$("00" & Hex(b(5)), 2)
End If
MakeMacAddress = buff
MakeMac_exit:
Exit Function
MakeMac_error:
MakeMacAddress = "(error building MAC address)"
Resume MakeMac_exit
End Function
Private Function BitsNeededForDecimals(ByVal NumDecimals As Long) As Long
BitsNeededForDecimals = Int(Log(10 ^ NumDecimals) / Log(2)) + 1
End Function
Public Function GetComputerIDString() As String
Dim iSource As Long
Dim iStr As String
Dim o As Object
Const sPipe = "|"
Dim iError As String
Dim iUUID As String
Static sValue As String
If sValue = "" Then
iStr = GetSystemIdentificationInfo2(iSource)
If (iSource > 0) And (iSource < 3) Then
sValue = iStr & sPipe
End If
On Error Resume Next
' from https://www.vbforums.com/showthread.php?905201-Identify-computer&p=5649565&viewfull=1#post5649565
' also https://www.vbforums.com/showthread.php?905400-Get-a-computer-hardware-ID&p=5650466&viewfull=1#post5650466
With GetObject("winmgmts:")
For Each o In .ExecQuery("SELECT ProcessorID FROM Win32_Processor WHERE ProcessorID is NOT NULL")
sValue = sValue & o.ProcessorId & sPipe: Exit For
Next o
For Each o In .ExecQuery("SELECT Manufacturer, Product FROM Win32_BaseBoard")
sValue = sValue & o.Manufacturer & sPipe & o.Product & sPipe: Exit For
Next o
For Each o In .ExecQuery("SELECT Version FROM Win32_BIOS")
sValue = sValue & o.Version: Exit For
Next o
End With
iUUID = GetMachineUUID(iError)
If (iError = "") And (iUUID <> "") Then
sValue = sValue & sPipe & iUUID
End If
Dim iMacCount As Long
Dim iMACAddresses() As String
iMacCount = GetNBMacAddresses(iMACAddresses(), ":")
If iMacCount > 0 Then
sValue = sValue & sPipe & iMACAddresses(0)
End If
End If
GetComputerIDString = sValue
End Function
Public Function GetComputerIDNumber(Optional ByVal nDigits As Long = 10) As String
Dim b As Long
Dim iComputerString As String
Dim iBytes() As Byte
Dim v As Variant
Dim c As Long
Static sValue As String
Static sValue_Digits As Long
If (sValue = "") Or (nDigits <> sValue_Digits) Then
If nDigits < 1 Then nDigits = 1
If nDigits > 30 Then Err.Raise 5: nDigits = 30
b = BitsNeededForDecimals(nDigits) / 8
If b = 0 Then b = 1
iComputerString = GetComputerIDString
ReDim iBytes(b - 1)
HashDataAny StrPtr(iComputerString), 2 * Len(iComputerString), iBytes(0), b
v = CDec(0)
For c = 0 To UBound(iBytes)
v = v + iBytes(c) * 256 ^ c
Next c
sValue = Right$("00" & Trim$(Str$(v)), nDigits)
sValue_Digits = nDigits
End If
GetComputerIDNumber = sValue
End Function
Public Function GetDiskCount() As Long
If Not mDiskInfoRetrieved Then RetrieveDiskInfo
GetDiskCount = mDiskCount
End Function
Public Function GetDiskIDString(Optional nDiskIndex As Long = 0) As String
If Not mDiskInfoRetrieved Then RetrieveDiskInfo
GetDiskIDString = mDiskIDString(nDiskIndex)
End Function
Public Function GetDiskIDNumber(Optional nDiskIndex As Long = 0, Optional ByVal nDigits As Long = 10) As String
Dim iStr As String
Dim b As Long
Dim iDiskString As String
Dim iBytes() As Byte
Dim v As Variant
Dim c As Long
If nDigits < 1 Then nDigits = 1
If nDigits > 30 Then Err.Raise 5: nDigits = 30
iStr = GetDiskIDString(nDiskIndex)
If iStr <> "" Then
b = BitsNeededForDecimals(nDigits) / 8
If b = 0 Then b = 1
iDiskString = GetDiskIDString(nDiskIndex)
ReDim iBytes(b - 1)
HashDataAny StrPtr(iDiskString), 2 * Len(iDiskString), iBytes(0), b
v = CDec(0)
For c = 0 To UBound(iBytes)
v = v + iBytes(c) * 256 ^ c
Next c
GetDiskIDNumber = Right$("00" & Trim$(Str$(v)), nDigits)
End If
End Function
Private Sub RetrieveDiskInfo()
Dim iDiskInfoObj As Object
Dim o As Object
Dim s As String
Dim c As Long
Dim c2 As Long
Dim iCount As Long
Dim iDiskIDString() As String
If mDiskInfoRetrieved Then Exit Sub
Set iDiskInfoObj = GetObject("winmgmts:").InstancesOf("Win32_DiskDrive")
On Error Resume Next
iCount = iDiskInfoObj.Count
ReDim iDiskIDString(iCount - 1)
ReDim iDiskIDNumber(iCount - 1)
mDiskCount = 0
For Each o In iDiskInfoObj
s = ""
s = o.Model & "|" & o.SerialNumber & "|" & o.Size
If s <> "" Then
iDiskIDString(mDiskCount) = s
mDiskCount = mDiskCount + 1
End If
Next
On Error GoTo 0
If mDiskCount > 0 Then
ReDim mDiskIDString(mDiskCount - 1)
c2 = 0
For c = iCount - 1 To 0 Step -1
If iDiskIDString(c2) <> "" Then
mDiskIDString(c2) = iDiskIDString(c)
c2 = c2 + 1
End If
Next
End If
mDiskInfoRetrieved = True
End Sub
Form1 test code:
Code:
Option Explicit
Private Sub Form_Load()
Dim n As String
Dim c As Long
MsgBox "Computer ID String: " & vbCrLf & vbCrLf & GetComputerIDString
n = GetComputerIDNumber
n = Left$(n, 5) & "-" & Mid$(n, 6)
MsgBox "Computer ID number:" & vbCrLf & vbCrLf & n
For c = 0 To GetDiskCount - 1
MsgBox "Disk " & c & " ID String: " & vbCrLf & vbCrLf & GetDiskIDString(c)
n = GetDiskIDNumber(c)
n = Left$(n, 5) & "-" & Mid$(n, 6)
MsgBox "Disk " & c & " ID number: " & vbCrLf & vbCrLf & n
Next
End Sub
Last edited by Eduardo-; Jul 19th, 2024 at 05:26 AM.
Skillset: VMS,DOS,Windows Sysadmin from 1985, fault-tolerance, VaxCluster, Alpha,Sparc. DCL,QB,VBDOS- VB6,.NET, PHP,NODE.JS, Graphic Design, Project Manager, CMS, Quad Electronics. classic cars & m'bikes. Artist in water & oils. Historian.
By the power invested in me, all the threads I start are battle free zones - no arguing about the benefits of VB6 over .NET here please. Happiness must reign.
Yes, this is very nice. I am curious about a few things though:
What does it do in a VM environment?
What happens if you have 2 (or more) NIC devices?
How are you actually using it for anti-piracy (just curious)?
Make an HTTPS call into your cloud database?
Save something in the registry on installation?
Patch the EXE (God forbid)?
Save a hidden file somewhere in AppData or ProgramData?
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Yes, this is very nice. I am curious about a few things though:
What does it do in a VM environment?
Hello Elroy.
That needs testing. The idea is that the MACAddress changes and and the ProcessorID may also change (not tested so far).
Originally Posted by Elroy
What happens if you have 2 (or more) NIC devices?
It will take the address of the first one only.
Originally Posted by Elroy
How are you actually using it for anti-piracy (just curious)?
Make an HTTPS call into your cloud database?
Save something in the registry on installation?
Patch the EXE (God forbid)?
Save a hidden file somewhere in AppData or ProgramData?
In the use case of the program that I'm working now, the last option (Save a hidden file somewhere in AppData). But the protection itself is up to the programmer.
This code only provides an ID for the particular user's computer, that is intended not to change after a Windows re-installation, even deleting the partitions and partitioning again, or even when doing BIOS updates.
Well, BIOS updates can change many things, like the MAC address but in principle they shouldn't do that.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
This has been coming along nicely. What are you using the disk info for since it's not involved in calculating the computer number?
They are alternative hardware ID numbers, in case that you need to provide more than one.
For example, if you want to generate licenses where the user can change the computer, but as long as a disk remains, the license still works.
Not sure if it matters but your "RetrieveDiskInfo" function will not return anything in a virtual machine because the "SerialNumber" property is not available for a virtual disk so it results in a "Object does not support method or property" error but that is ignored due to "On Error Resume Next". You might want to implement a more robust error protection such as fallback to "VolumeSerialNumber" instead.
I think it is "perfect" as it is then. We want only hardware serials, and a VM has no hardware disks.
If the programmer using this code finds that there is no disks, he can do one of two things: use only the computer ID, or tell that the license can't be issued for VMs.
Not sure if it matters but your "RetrieveDiskInfo" function will not return anything in a virtual machine because the "SerialNumber" property is not available for a virtual disk so it results in a "Object does not support method or property" error but that is ignored due to "On Error Resume Next". You might want to implement a more robust error protection such as fallback to "VolumeSerialNumber" instead.
Does iDiskInfoObj.Count return the number of disks?
If that works, I'll have to return 0 (zero) I think.
Yes of course, it does return one for the number of disks and the model is something like "VMWare SCSI Virtual Drive" or similar. Even the size is reported correctly. Only the "SerialNumber" property fails so that's another method to detect virtual machines, same as the "TemperatureProbe" (since only physical CPUs have temperature sensors).
There's still a bug in there. I guess these are the perils of using "On Error Resume Next".
Code:
s = o.Model & "|" & o.SerialNumber & "|" & o.Size
This string will always be empty when the "SerialNumber" property is not available (such as in virtual machines) and as such "ReDim mDiskIDString(mDiskCount - 1)" will produce error 9 "Subscript out of range" since you've turned on error checking right above it.
For Each o In iDiskInfoObj
s = ""
s = o.Model & "|" & o.SerialNumber & "|" & o.Size
If s <> "" Then
mDiskCount = mDiskCount + 1
iDiskIDString(o.Index) = s
End If
Next
The problem is that "o.Index" does not start at zero as expected. Here is the corrected version:
Code:
For Each o In iDiskInfoObj
s = o.Model & "|" & o.SerialNumber & "|" & o.Size
If Len(s) Then
iDiskIDString(mDiskCount) = s
mDiskCount = mDiskCount + 1
End If
Next o
This error could have been easily caught if you didn't use "On Error Resume Next".
Last edited by VanGoghGaming; Jul 19th, 2024 at 04:46 AM.
Also I've been testing this project in a virtual machine with Windows XP (just because I have one from the good old days) and as I've mentioned before the "ItemIndex(0)" property is not available in XP so basically the whole computer number is based only on the MACAddress retrieved from NetBios. You should replace "ItemIndex(0)" with the "For Each ... Exit For" syntax to make your code more robust in this rare case.
Code:
Const sPipe = "|"
With GetObject("winmgmts:")
For Each o In .ExecQuery("SELECT ProcessorID FROM Win32_Processor WHERE ProcessorID is NOT NULL")
GetComputerIDString = GetComputerIDString & o.ProcessorId & sPipe: Exit For
Next o
For Each o In .ExecQuery("SELECT Manufacturer, Product FROM Win32_BaseBoard")
GetComputerIDString = GetComputerIDString & o.Manufacturer & sPipe & o.Product & sPipe: Exit For
Next o
For Each o In .ExecQuery("SELECT Version FROM Win32_BIOS")
GetComputerIDString = GetComputerIDString & o.Version: Exit For
Next o
End With
Last edited by VanGoghGaming; Jul 19th, 2024 at 05:00 AM.
For Each o In iDiskInfoObj
s = ""
s = o.Model & "|" & o.SerialNumber & "|" & o.Size
If s <> "" Then
mDiskCount = mDiskCount + 1
iDiskIDString(o.Index) = s
End If
Next
The problem is that "o.Index" does not start at zero as expected. Here is the corrected version:
Code:
For Each o In iDiskInfoObj
s = o.Model & "|" & o.SerialNumber & "|" & o.Size
If Len(s) Then
iDiskIDString(mDiskCount) = s
mDiskCount = mDiskCount + 1
End If
Next o
.
It does not start at 0 and that's why I used 'o.Index' instead of a counter. I believe the order is inverted but not sure that's why I used o.Index, because the o.Index with zero is the first disk, and I want the first disk to appear with index 0 in my result (and not with the last index as if I had used a counter).
Originally Posted by VanGoghGaming
This error could have been easily caught if you didn't use "On Error Resume Next
As explained, it is not an error, it is on purpose.
Well as you say, but I've just tested it and on the first step of the iteration "o.Index" was 5 for me and it errored with "Subscript out of range" because "iCount" is only 4. Probably the same happened for cliv above.
Well as you say, but I've just tested it and on the first step of the iteration "o.Index" was 5 for me and it errored with "Subscript out of range" because "iCount" is only 4. Probably the same happened for cliv above.
OK, then I will make a counter but inverting the order. Thanks for checking.
Here I have two SDD and the first one is index 1 and the second index 0. I thought that these indexes wouldn't go out of bounds but wasn't sure.
Looks good now. I guess the ultimate test would be to reinstall Windows (possibly upgrade from 10 to 11 or similar) and also update the BIOS and see what happens.
Also I've been meaning to ask, what are you doing with this number after dictating it over the phone? Are you hashing it again and dictating the result back to the user?
Looks good now. I guess the ultimate test would be to reinstall Windows (possibly upgrade from 10 to 11 or similar) and also update the BIOS and see what happens.
Yeap.
Originally Posted by VanGoghGaming
Also I've been meaning to ask, what are you doing with this number after dictating it over the phone? Are you hashing it again and dictating the result back to the user?
I'm going to use a five digits numbers (the default is ten digits in the function).
I think that 100,000 different IDs are more than enough. 4 digits also could work, even 3 digits.
Because the idea is not that these ID should not repeat, but that a license issued for one computer should not be able to be used on another.
What I'm going to do?
The license number is something like this:
Code:
0794-0504-0209-1516-9752
The user first need to pass her/his computer ID, that is a 5-digit number, then from the other side they use a program that I made to generate the licenses. They enter that 5-digit number, and it generates that 20 digit license number where are codified a couple of things, like the program version, and now also the 5-digit number. Many of the license numbers are for checksum/control.
It won't change much from how they were handling the licenses before, it is the same 20-digit license number. The difference is that now the user needs to send the 5-digits ID number of the computer.
Note for other people reading: I say "they" because I'm not the one distributing this program but an organization I made the program for.
Probably they'll use more email or WhatsApp, but maybe phone also.
If anyone is going to reinstall Windows on any computer, if you want to help, please:
Save the GetComputerIDString and GetComputerIDNumber to a file in a USB drive or upload it to internet, and check the values again after Windows re-installation to see if they changed.
Attached in the program to run. If you don't have the VB6 IDE on that computer, then compile it first on your development computer.
Change "D:" in const cPath to a path that you can save.
Thanks.
Reply With Quote
Originally Posted by Elroy
Re: Get a computer hardware ID
Re: Get a computer hardware ID
Re: Get a computer hardware ID
