you can do nothing to prevent piracy as they usually have more time and resources to crack anything you throw at them.
In general I agree, because that is matter of fact, it is never impossible to crack a program... but, I found that in practice you can make the cracking difficult. Not impossible of course, but they will have to spend a good time to be able to crack it if done "right".
Of course that also requires a good work from the developer in the protection, but the developer has the advantage of seeing the source code. So probably it will take several times more work to the hacker to crack it than what it took to the developer to make the protection.
Basically the idea is to demoralize, dishearten and make him to give up. By making it hard, and making him believe that he found the logic, that he cracked it, just to find out that it was a trap. So there must be several levels of traps and deceiving paths. That's why I said that it takes some work.
Also one must ask the question: does the program worth enough to do that work?
In the past, after being cracked, I made a good protection for the next version of that program (that was a bit popular at the time), and many asked for a crack and there was no crack... for a time. But there is always a weakness. I had not considered protection against brute force attempts. And someone could, with brute force, find a working key.
In the next version I added protection against brute force. It was quite a learning for me.
So, yes, it is not impossible but I won't make it too easy either.
Anyway when AI programs start cracking, we're screwed.
PS: and in the case of this particular program I don't think any cracker would be interested in cracking it. So any basic protection would be enough (still, the protection is not so basic).
Have you actually bothered to time the execution or you literally took that post word for word?
Code:
Dim qpcStart As Currency, qpcEnd As Currency
QueryPerformanceCounter qpcStart
Debug.Print GetObject("winmgmts:").ExecQuery("SELECT ProcessorID FROM Win32_Processor WHERE ProcessorID IS NOT Null").ItemIndex(0).ProcessorID
QueryPerformanceCounter qpcEnd: Debug.Print qpcEnd - qpcStart
This takes 20ms on my system so it should be entirely acceptable.
It also seems to be the case that the ProcessorId is shared by entire families of processors, so I think some other data like the mobo_model/BIOS_date could be good to be added too, besides SystemIdForPublisher&MACAddress&ProcessorID
It's good to see that you are coming to the same conclusion especially since I've already mentioned above that the ProcessorId is the same for a given family of processors! But it is still valuable especially for virtual machines where there isn't much choice because all other components will remain unchanged when cloned (except the MACAddress) so it doesn't make sense to add motherboard model, etc.
Virtual machines are considered mostly disposable so I don't think anyone will bother to activate Windows for them because it works just fine in perpetual trial mode without activation if you don't mind the watermark that pops up in the bottom-right corner after a while (but goes away after a reboot).
From your story I see that you have extensive experience with license keys. Would you mind sharing (in broad terms) what kind of "traps" did you implement? I was thinking that checking against an online database would be the best you could do...
Have you actually bothered to time the execution or you literally took that post word for word?
No, I didn't measure the time, but I saw that it takes like a second or so.
Now tested:
Code:
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Sub Command1_Click()
Dim qpcStart As Currency, qpcEnd As Currency
QueryPerformanceCounter qpcStart
Debug.Print GetObject("winmgmts:\\.\root\cimv2:Win32_Processor='cpu0'").processorID
QueryPerformanceCounter qpcEnd: Debug.Print qpcEnd - qpcStart
End Sub
1935,6848 milliseconds here
Anyway, your code is much faster, so I would use that instead.
153,3975 milliseconds the fist time and 15,6913 milliseconds the second time and after.
Originally Posted by VanGoghGaming
But it is still valuable especially for virtual machines where there isn't much choice because all other components will remain unchanged when cloned (except the MACAddress) so it doesn't make sense to add motherboard model, etc.
Virtual machines are considered mostly disposable so I don't think anyone will bother to activate Windows for them because it works just fine in perpetual trial mode without activation if you don't mind the watermark that pops up in the bottom-right corner after a while (but goes away after a reboot).
I had in mind previous versions of Windows that don't have SystemIdForPublisher available, more than VM, but VM also are an issue.
Alternatively we could say that for VM the licenses are not available, if we want.
In this specific case I don't think it is important. But anyway I'm thinking also in reusable code for the future.
Originally Posted by VanGoghGaming
From your story I see that you have extensive experience with license keys. Would you mind sharing (in broad terms) what kind of "traps" did you implement? I was thinking that checking against an online database would be the best you could do...
It depends very much on the features of the program, because you need to check the license in different places, and in places that are main features of the program that can't be short-circuited to bypass the license check.
One rule was not to disclose "your secrets", but what the heck...
OK, one thing that I did was to check the license, not do just a basic checking, but two checks, one that with little data that matched it passed (so the cracker can think that that was the whole check). But the actual hard check was several steps later.
Also, try to confuse the branches, like LicenseIsOK is set when it is actually wrong (and vice-versa).
Do part of the check, and another part with a timer that fires some milliseconds later.
Do some loop, that increases if the program is delayed for running step by step (so if the cracker go step by step, it takes forever in that loop).
As I said: check the license in different places of the program. They must be important parts that cannot be bypassed. Check if the program passed for some part of the license checking, if it didn't pass, they do some "evil thing", like an calling ExitProcess.
Sometimes you can do that the program works, but does not work fine, and make errors instead.
And whatever idea you can have. Think what the cracker would be watching, and you have advantage because you are working with the source code. You need to make him give up.
He would have the advantage of the experience in cracking, so we don't have to underestimate.
One of the problems of programmers is that when it comes to protection, they are already tired, so they are lazy and do not make strong protections.
Those are more or less the ideas, roughly. I also used a random generator that was quite complex, not just the VB6's Rnd function.
I'm not a cracker myself, but I guess that adding complexity makes it harder to follow.
I guess there must be a few crackers here that could say if this is nonsense or makes sense. But from my own perspective, it seemed to work.
But as I said in the previous message, sometime you think in many things and overlook some simple weakness, like when I didn't think about brute force serial tries.
So, well, you can't make it uncrackeable, but to make it harder.
And it is also a bit a matter of self-pride, I didn't like being cracked, so I've put some effort in trying to avoid it.
If you worked let's say 3 months in a program, you can work a week more in the protection.
OK, one thing that I did was to check the license, not do just a basic checking, but two checks, one that with little data that matched it passed (so the cracker can think that that was the whole check). But the actual hard check was several steps later.
After that first easy check, show the message that the license was OK.
The actual check will be later (with the timer).
Originally Posted by Eduardo-
Do part of the check, and another part with a timer that fires some milliseconds later.
If the license was not OK in the true check done in the timer, you can fire another timer to exit the program some seconds later without saying anything.
If that timer is never executed, you can have a fourth timer to check whether the other timer was executed or not. Instead of closing the program you can raise an error, like b = 0 : a = 1/b.
So, there must be some checks of the other checks, because the cracker can bypass or erase sections of code.
Thanks for sharing your insights, very devious indeed! It's a lot of work to obfuscate your code in this manner but it's a necessary evil.
That's why I said an online check would be a lot easier. You could have a lot of uninitialized variables, constants and other data all through the program and you would receive the required data from the server after the license is validated.
Regarding systems with Windows 8, 7 or older where SystemIdForPublisher is not available I still think the ideas from post #62 are a good starting point.
Basically the idea is to demoralize, dishearten and make him to give up. By making it hard, and making him believe that he found the logic, that he cracked it, just to find out that it was a trap. So there must be several levels of traps and deceiving paths. That's why I said that it takes some work.
Also one must ask the question: does the program worth enough to do that work?
If the program is costly enough and cool enough, they won't ever give up.
So, there must be some checks of the other checks, because the cracker can bypass or erase sections of code.
And then you could have a fifth timer that would check the integrity of the digital signature of your executable and execute Log(0) if it doesn't validate!
If the program is costly enough and cool enough, they won't ever give up.
They won't ever give up because it is not a matter of cost, it is a matter of pride.
The program just needs to be interesting enough to make the first try.
But "ever" doesn't work in practice. People get tired (let's say a month, two months).
If it was a matter of national security for sure the government would hire a team or do the necessary to do that work, but we would be talking of another level there.
If you really don't want your program to be cracked I would not challenge the crackers to crack your program.
For example I would not defy some that participated in this thread (not saying that they are crackers ).
OK, here is the first version of the identification module.
I used wqweto's code for GetSystemIdForPublisher and VanGoghGaming's ideas and code (with some variations) to complete the identification.
mdlSystemIdentificationInfo bas module:
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 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
Public Function GetComputerIDString() As String
Dim iSource As Long
Dim iStr As String
iStr = GetSystemIdentificationInfo2(iSource)
If (iSource > 0) And (iSource < 3) Then
GetComputerIDString = iStr & "|"
End If
On Error Resume Next
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT ProcessorID FROM Win32_Processor WHERE ProcessorID is NOT NULL").ItemIndex(0).ProcessorID & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT Product FROM Win32_BaseBoard WHERE Product is NOT NULL").ItemIndex(0).Product & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT SerialNumber FROM Win32_BaseBoard WHERE SerialNumber is NOT NULL").ItemIndex(0).SerialNumber & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT Version FROM Win32_BIOS WHERE Version is NOT NULL").ItemIndex(0).Version & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT ReleaseDate FROM Win32_BIOS WHERE ReleaseDate is NOT NULL").ItemIndex(0).ReleaseDate & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT Description FROM Win32_BIOS WHERE Description is NOT NULL").ItemIndex(0).Description & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT SerialNumber FROM Win32_BIOS WHERE SerialNumber is NOT NULL").ItemIndex(0).SerialNumber & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT ProductName, MACAddress FROM Win32_NetworkAdapter WHERE MACAddress is NOT NULL").ItemIndex(0).ProductName & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapter WHERE MACAddress is NOT NULL").ItemIndex(0).MACAddress
End Function
Private Function BitsNeededForDecimals(ByVal NumDecimals As Long) As Long
BitsNeededForDecimals = Int(Log(10 ^ NumDecimals) / Log(2)) + 1
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
If nDigits < 1 Then nDigits = 1
If nDigits > 15 Then Err.Raise 5: nDigits = 15
b = BitsNeededForDecimals(nDigits) / 8
If b = 0 Then b = 1
iComputerString = GetComputerIDString
Dim c As Long
ReDim iBytes(b - 1)
HashDataAny StrPtr(iComputerString), 2 * Len(iComputerString), iBytes(0), b
v = 0
For c = 0 To UBound(iBytes)
v = v + iBytes(c) * 256 ^ c
Next c
GetComputerIDNumber = Right$("00" & Trim$(Str$(v)), nDigits)
End Function
Test code in form:
Code:
Private Sub Form_Load()
Dim n As String
MsgBox "Computer ID String: " & vbCrLf & vbCrLf & GetComputerIDString
n = GetComputerIDNumber
n = Left$(n, 5) & "-" & Mid$(n, 6)
MsgBox "Computer ID number:" & vbCrLf & vbCrLf & n
End Sub
I changed my mind about also allow the identification from disks and memmory sticks. I'll make it simple and at least for this version it will be identified only by the core machine.
Edit: please test, specially if you have the chance in Windows 7.
Suggestions? A fallback if < Windows 10 and WMI disabled?
Last edited by Eduardo-; Jul 11th, 2024 at 06:34 AM.
Statistically speaking it is more likely for users to update their BIOS than change the SSD containing their Windows installation, so I wouldn't use any of those BIOS strings. From "Win32_BaseBoard" I'd go with "Manufacturer" and "Product" because "SerialNumber" just outputs "Default string" which is useless. Also don't shorten the SQL syntax for MACAddress because there is no guarantee that physical adapters are listed first and the complete SQL syntax I posted above weeds out all those virtual adapters that are always present.
Since your code is based on "On Error Resume Next" it will work even on Windows XP as it is!
Since your code is based on "On Error Resume Next" it will work even on Windows XP as it is!
Just tested it in a XP virtual machine and for some reason the "ItemIndex" property of the WMIObjectSet is not recognized but there's a simple workaround for it that works on all Windows versions. As a general rule of thumb, once you acquire a WMIServices object, its methods will return an ObjectSet (much like a RecordSet from ADO if that's more familiar to you).
This ObjectSet can be iterated with the "For Each" syntax (and you can always "Exit For" if you're interested only in the first result) when the "ItemIdex" property is not available. You can obtain an "ObjectSet" with the "InstancesOf" method (which is equivalent to "SELECT * FROM" and as such it will take longer to execute) or the "ExecQuery" method that allows more granular control over what properties you're interested in. You only need one "ExecQuery" call per WMI class to retrieve all properties (SELECT Field1, Field2, Field3, etc FROM Win32_Whatever).
Code:
Public Sub Main()
Dim objWMIServices As SWbemServices, objWMIObjectSet As SWbemObjectSet, objWMI As SWbemObject
Set objWMIServices = GetObject("winmgmts:")
If Not objWMIServices Is Nothing Then
Set objWMIObjectSet = objWMIServices.ExecQuery("SELECT ProductName, MACAddress FROM Win32_NetworkAdapter WHERE (MACAddress IS NOT Null)")
' Set objWMIObjectSet = objWMIServices.ExecQuery("SELECT ProductName, MACAddress FROM Win32_NetworkAdapter WHERE (MACAddress IS NOT Null) AND (Manufacturer <> 'Microsoft') AND NOT(PNPDeviceID LIKE 'ROOT\\%')")
If Not objWMIObjectSet Is Nothing Then
For Each objWMI In objWMIObjectSet
Debug.Print objWMI.ProductName, objWMI.MACAddress
Next objWMI
End If
End If
End Sub
This code runs early bound using a reference to "Microsoft WMI Scripting V1.2 Library" and it works correctly on Windows XP or newer. You could remove the reference if you want and declare variables late bound "As Object". Run this code as is and then compare the results when removing the comment from the second SQL statement to see the difference.
Statistically speaking it is more likely for users to update their BIOS than change the SSD containing their Windows installation, so I wouldn't use any of those BIOS strings.
How many times did you update your BIOS and how many times did you reinstall Windows?
(I updated my BIOS once but it was a very special and weird case... and a mistake. At the same time I reinstalled Windows like 5 times at least. I never before had flashed a BIOS in my life.)
Originally Posted by VanGoghGaming
"SerialNumber" just outputs "Default string" which is useless
Also here, but I guessed that in some mobos it must work. Anyway it does not harm. But I can remove them.
Originally Posted by VanGoghGaming
Since your code is based on "On Error Resume Next" it will work even on Windows XP as it is!
That was the idea. But I'm a bit worried for the case when WMI is not available. Maybe I should add at least one identification not based on WMI.
How many times did you update your BIOS and how many times did you reinstall Windows?
Well this computer is a 10th generation Intel so it's already 4 years old (I think I built it in early 2020). I've never reinstalled Windows since it works the same as the first time but I did update the BIOS at least 4 times (last time in January this year since the Gigabyte site said it contained some vulnerability fixes). Obviously this is not a typical scenario since most users could care less about BIOS fixes, haha!
Just to clarify, reinstalling Windows will NOT change the SSD hardware serial number! I gave you the code to retrieve this hardware serial number above. It narrows down the hard drive that contains the Windows BootPartition since many users would have more than one hard drive in their computers.
Also here, but I guessed that in some mobos it must work. Anyway it does not harm. But I can remove them.
"SELECT Manufacturer, Product FROM Win32_BaseBoard" are the most useful properties you could squeeze out from a motherboard.
That was the idea. But I'm a bit worried for the case when WMI is not available. Maybe I should add at least one identification not based on WMI.
WMI is always available (it can't be disabled), however it "may" be possible that some queries require the user to have administrator rights (I haven't verified this). Also if it were possible, users could disable WMI on purpose just to get a free key from you that would work on many other computers!
Well this computer is a 10th generation Intel so it's already 4 years old (I think I built it in early 2020). I've never reinstalled Windows since it works the same as the first time but I did update the BIOS at least 4 times (last time in January this year since the Gigabyte site said it contained some vulnerability fixes). Obviously this is not a typical scenario since most users could care less about BIOS fixes, haha!
I don't think that many people do what you did, and I advice not to update the BIOS. The only time I did, my computer didn't work anymore and I've been many days without the computer. I had to buy a EEPROM programmer to fix it.
Originally Posted by VanGoghGaming
Just to clarify, reinstalling Windows will NOT change the SSD hardware serial number! I gave you the code to retrieve this hardware serial number above. It narrows down the hard drive that contains the Windows BootPartition since many users would have more than one hard drive in their computers.
It really depends on the kind of program for the type of users. In this case I think they will have mostly laptops, so they won't change anything.
Even tech people like us, lastly we don't change micros or motherboards, we don't upgrade the computers. We can add memory, some disks. But when we purchase a new computer we usually purchase all new, and leave the old computer to someone else or as second computer.
So... to carry an old disk to a new computer I don't think it is so frequent nowadays as it used to be.
Doing the second identification with a disk serial makes the user to have to send more data... I already had decanted to a simpler option...
Originally Posted by VanGoghGaming
"SELECT Manufacturer, Product FROM Win32_BaseBoard" are the most useful properties you could squeeze out from a motherboard.
I didn't add 'Manufacturer' because I think it adds nothing if you already have 'Product'. I don't think there could be a case of the same 'Product' but different 'Manufacturer'.
Maybe there is a case when 'Product' is not available but 'Manufacturer' is. Still, 'Manufacturer' is more generic than 'Product' so I don't see it as a very good one to add. But since it is free and it doesn't harm I could add it too.
Originally Posted by VanGoghGaming
WMI is always available (it can't be disabled), however it "may" be possible that some queries require the user to have administrator rights (I haven't verified this).
The ones that I used did not require admin rights. We don't want to require admin rights, no.
Originally Posted by VanGoghGaming
Also if it were possible, users could disable WMI on purpose just to get a free key from you that would work on many other computers!
Stop winmgmt service The following procedure describes how to stop the WMI service: At a command prompt, enter net stop winmgmt . Other services that are dependent on the WMI service also halt, such as SMS Agent Host or Windows Firewall.
I don't think that many people do what you did, and I advice not to update the BIOS. The only time I did, my computer didn't work anymore and I've been many days without the computer. I had to buy a EEPROM programmer to fix it.
Is this like a really old story? On computers from the last decade it's not really possible to mess up the flashing process since it won't let you continue if the checksum doesn't match what your board is expecting. Also most boards have a backup BIOS if the main one gets corrupted somehow. Some BIOS's have network access and can download and install the latest version without having an operating system installed. There are certain brands of laptops (like "HP" for one) that update the BIOS automatically without user interaction. All-in-all BIOS updates have become a necessity because they fix vulnerabilities and hardware incompatibilities with newer components. You should check your motherboard's website to see what the latest BIOS brings to the table.
It really depends on the kind of program for the type of users. In this case I think they will have mostly laptops, so they won't change anything.
Even tech people like us, lastly we don't change micros or motherboards, we don't upgrade the computers. We can add memory, some disks. But when we purchase a new computer we usually purchase all new, and leave the old computer to someone else or as second computer.
So... to carry an old disk to a new computer I don't think it is so frequent nowadays as it used to be.
Doing the second identification with a disk serial makes the user to have to send more data... I already had decanted to a simpler option...
All I'm saying is that the hardware SSD number should be more reliable than the motherboard Manufacturer/Product.
The ones that I used did not require admin rights. We don't want to require admin rights, no.
I didn't mean raising an UAC prompt but have you checked while being logged on as a standard user rather than an administrator?
This is what I meant by going down the rabbit hole in the beginning of this thread. How deep are you willing to go since the hole is never-ending? You could attempt to start the winmgmt service again if it's stopped:
Also I was curious why are you calculating some big number from the byte-array returned by "HashData"? Shouldn't converting it to a hex string accomplish the task?
Just a little update on this, it turned out to be a non-issue. I took the small code snippet from post #93 above, put it in a new project and compiled it to "Project1.exe". Then executed "net stop winmgmt" in an admin command prompt window, confirmed it had stopped successfully and then executed "Project1.exe".
Can you guess what happened? Nothing, it worked just fine! It turns out the winmgmt service started itself when called upon, haha!
On computers from the last decade it's not really possible to mess up the flashing process
That's what I thought. But obviously I was wrong.
I almost had to buy a new motherboard, that what I was told from the tech service.
Originally Posted by VanGoghGaming
since it won't let you continue if the checksum doesn't match what your board is expecting.
How can the motherboard know the valid checksums of all possible (future) BIOS updates, if updates by definition are something new not known at the time of the original fabrication?
Originally Posted by VanGoghGaming
Also most boards have a backup BIOS if the main one gets corrupted somehow.
Most? For sure not this one. And it was a quite expensive "professional" motherboard that I purchased, not a cheap one.
Originally Posted by VanGoghGaming
You should check your motherboard's website to see what the latest BIOS brings to the table.
I don't think so. No way.
I don't think I'll ever flash a BIOS again unless that's really necessary. But at least not with this motherboard.
Originally Posted by VanGoghGaming
All I'm saying is that the hardware SSD number should be more reliable than the motherboard Manufacturer/Product.
They are different things. One is to identify the motherboard/processor and the other would be to have the option of also recognizing a drive after a computer upgrade.
So the drive serial number would be for a totally different use case.
Originally Posted by VanGoghGaming
I didn't mean raising an UAC prompt but have you checked while being logged on as a standard user rather than an administrator?
How do you run as administrator without raising an UAC prompt?
Anyway I run VB6 IDE as normal user normally, to avoid this kind of issues.
Originally Posted by VanGoghGaming
This is what I meant by going down the rabbit hole in the beginning of this thread. How deep are you willing to go since the hole is never-ending? You could attempt to start the winmgmt service again if it's stopped:
No, no way. If WMI is disabled it could be for an important reason, like a company rule or something, I won't attempt to turn it on. I'll prefer to say "it is not possible to run this program here because WMI is disabled" instead.
Originally Posted by VanGoghGaming
Also I was curious why are you calculating some big number from the byte-array returned by "HashData"? Shouldn't converting it to a hex string accomplish the task?
That's the idea: to avoid letters and produce only numbers. They are easier to dictate by phone, avoiding misunderstandings.
Just to clarify, reinstalling Windows will NOT change the SSD hardware serial number! I gave you the code to retrieve this hardware serial number above.
New version of mdlSystemIdentificationInfo bas module with VanGoghGaming's suggestions:
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
'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
Public Function GetComputerIDString() As String
Dim iSource As Long
Dim iStr As String
iStr = GetSystemIdentificationInfo2(iSource)
If (iSource > 0) And (iSource < 3) Then
GetComputerIDString = iStr & "|"
End If
On Error Resume Next
' from https://www.vbforums.com/showthread.php?905201-Identify-computer&p=5649565&viewfull=1#post5649565
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT ProcessorID FROM Win32_Processor WHERE ProcessorID is NOT NULL").ItemIndex(0).ProcessorID & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT Manufacturer FROM Win32_BaseBoard WHERE Manufacturer is NOT NULL").ItemIndex(0).Manufacturer & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT Product FROM Win32_BaseBoard WHERE Product is NOT NULL").ItemIndex(0).Product & "|"
GetComputerIDString = GetComputerIDString & GetObject("winmgmts:").ExecQuery("SELECT Version FROM Win32_BIOS WHERE Version is NOT NULL").ItemIndex(0).Version & "|"
Dim objWMIServices As Object, objWMIObjectSet As Object, objWMI As Object
' from https://www.vbforums.com/showthread.php?905201-Identify-computer&p=5649804&viewfull=1#post5649804
Set objWMIServices = GetObject("winmgmts:")
If Not objWMIServices Is Nothing Then
Set objWMIObjectSet = objWMIServices.ExecQuery("SELECT ProductName, MACAddress FROM Win32_NetworkAdapter WHERE (MACAddress IS NOT Null)")
If Not objWMIObjectSet Is Nothing Then
For Each objWMI In objWMIObjectSet
GetComputerIDString = GetComputerIDString & objWMI.ProductName & "|" & objWMI.MACAddress
Exit For
Next objWMI
End If
End If
Dim iError As String
Dim iUUID As String
iUUID = GetMachineUUID(iError)
If (iError = "") And (iUUID <> "") Then
GetComputerIDString = GetComputerIDString & "|" & iUUID
End If
Dim iMacCount As Long
Dim iMACAddresses() As String
iMacCount = GetNBMacAddresses(iMACAddresses(), ":")
If iMacCount > 0 Then
GetComputerIDString = GetComputerIDString & "|" & iMACAddresses(0)
End If
End Function
Private Function BitsNeededForDecimals(ByVal NumDecimals As Long) As Long
BitsNeededForDecimals = Int(Log(10 ^ NumDecimals) / Log(2)) + 1
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
If nDigits < 1 Then nDigits = 1
If nDigits > 15 Then Err.Raise 5: nDigits = 15
b = BitsNeededForDecimals(nDigits) / 8
If b = 0 Then b = 1
iComputerString = GetComputerIDString
Dim c As Long
ReDim iBytes(b - 1)
HashDataAny StrPtr(iComputerString), 2 * Len(iComputerString), iBytes(0), b
v = 0
For c = 0 To UBound(iBytes)
v = v + iBytes(c) * 256 ^ c
Next c
GetComputerIDNumber = Right$("00" & Trim$(Str$(v)), nDigits)
End Function
Form1's test code:
Code:
Option Explicit
Private Sub Form_Load()
Dim n As String
MsgBox "Computer ID String: " & vbCrLf & vbCrLf & GetComputerIDString
n = GetComputerIDNumber
n = Left$(n, 5) & "-" & Mid$(n, 6)
MsgBox "Computer ID number:" & vbCrLf & vbCrLf & n
End Sub
A statistical profile of registered uninstaller strings (excluding system stuff as much as possible) could be built, checked at intervals and maintained.. but expected to be complex. It would have to be tolerant of changes above some threshold. In the extreme case, a user uninstalls every app they have ever installed and replaces them with new installs of different apps all in a single day, absurd of course. This profile data is then tangled up with stored user settings and data to make it less portable and make for additional potential minefields for anyone trying to use it on a different machine. Of course, this code itself has to be protected by internal proof-of-operation checks which are also purposely tangled up in the normal functioning of the program.
Originally Posted by wqweto
Reply With Quote
Re: Identify computer
But it is still valuable especially for virtual machines where there isn't much choice because all other components will remain unchanged when cloned (except the MACAddress) so it doesn't make sense to add motherboard model, etc.
Re: Identify computer
Re: Identify computer
Re: Identify computer
