The general idea to generate a Hardware ID (machine fingerprint) is collect data from the CPU, HDD, BIOS, NIC and another hardware components which have serial numbers and unique characteristics. you can use this ID to generate licenses based in this fingerprint which must be “unique” by machine.
for this simple sample i picked this set of WMI classes Win32_Processor (Get CPU info), Win32_BaseBoard (retrieve info about the motherboard), Win32_BIOS (Get BIOS Data) and Win32_OperatingSystem (Get Windows information). Of course you can choose other WMI classes, and combinations that you want.
Check the full source code of the hardware ID generator.
(Tested in Delphi 2007 and Delphi XE)
program WMIHardwareID; {$APPTYPE CONSOLE} {$DEFINE Use_Jwscl} //necessary to obtain a hash of the data using md2, md4, md5 or sha1 uses {$IFDEF Use_Jwscl} JwsclTypes, JwsclCryptProvider, {$ENDIF} Classes, SysUtils, ActiveX, ComObj, Variants; type TMotherBoardInfo = (Mb_SerialNumber,Mb_Manufacturer,Mb_Product,Mb_Model); TMotherBoardInfoSet= set of TMotherBoardInfo; TProcessorInfo = (Pr_Description,Pr_Manufacturer,Pr_Name,Pr_ProcessorId,Pr_UniqueId); TProcessorInfoSet = set of TProcessorInfo; TBIOSInfo = (Bs_BIOSVersion,Bs_BuildNumber,Bs_Description,Bs_Manufacturer,Bs_Name,Bs_SerialNumber,Bs_Version); TBIOSInfoSet = set of TBIOSInfo; TOSInfo = (Os_BuildNumber,Os_BuildType,Os_Manufacturer,Os_Name,Os_SerialNumber,Os_Version); TOSInfoSet = set of TOSInfo; const //properties names to get the data MotherBoardInfoArr: array[TMotherBoardInfo] of AnsiString = ('SerialNumber','Manufacturer','Product','Model'); OsInfoArr : array[TOSInfo] of AnsiString = ('BuildNumber','BuildType','Manufacturer','Name','SerialNumber','Version'); BiosInfoArr : array[TBIOSInfo] of AnsiString = ('BIOSVersion','BuildNumber','Description','Manufacturer','Name','SerialNumber','Version'); ProcessorInfoArr : array[TProcessorInfo] of AnsiString = ('Description','Manufacturer','Name','ProcessorId','UniqueId'); type THardwareId = class private FOSInfo : TOSInfoSet; FBIOSInfo : TBIOSInfoSet; FProcessorInfo : TProcessorInfoSet; FMotherBoardInfo: TMotherBoardInfoSet; FBuffer : AnsiString; function GetHardwareIdHex: AnsiString; {$IFDEF Use_Jwscl} function GetHashString(Algorithm: TJwHashAlgorithm; Buffer : Pointer;Size:Integer) : AnsiString; function GetHardwareIdMd5: AnsiString; function GetHardwareIdMd2: AnsiString; function GetHardwareIdMd4: AnsiString; function GetHardwareIdSHA: AnsiString; {$ENDIF} public //Set the properties to be used in the generation of the hardware id property MotherBoardInfo : TMotherBoardInfoSet read FMotherBoardInfo write FMotherBoardInfo; property ProcessorInfo : TProcessorInfoSet read FProcessorInfo write FProcessorInfo; property BIOSInfo: TBIOSInfoSet read FBIOSInfo write FBIOSInfo; property OSInfo : TOSInfoSet read FOSInfo write FOSInfo; property Buffer : AnsiString read FBuffer; //return the content of the data collected in the system property HardwareIdHex : AnsiString read GetHardwareIdHex; //get a hexadecimal represntation of the data collected {$IFDEF Use_Jwscl} property HardwareIdMd2 : AnsiString read GetHardwareIdMd2; //get a Md2 hash of the data collected property HardwareIdMd4 : AnsiString read GetHardwareIdMd4; //get a Md4 hash of the data collected property HardwareIdMd5 : AnsiString read GetHardwareIdMd5; //get a Md5 hash of the data collected property HardwareIdSHA : AnsiString read GetHardwareIdSHA; //get a SHA1 hash of the data collected {$ENDIF} procedure GenerateHardwareId; //calculate the hardware id constructor Create(Generate:Boolean=True); overload; Destructor Destroy; override; end; function VarArrayToStr(const vArray: variant): AnsiString; function _VarToStr(const V: variant): AnsiString; var Vt: integer; begin Vt := VarType(V); case Vt of varSmallint, varInteger : Result := AnsiString(IntToStr(integer(V))); varSingle, varDouble, varCurrency : Result := AnsiString(FloatToStr(Double(V))); varDate : Result := AnsiString(VarToStr(V)); varOleStr : Result := AnsiString(WideString(V)); varBoolean : Result := AnsiString(VarToStr(V)); varVariant : Result := AnsiString(VarToStr(Variant(V))); varByte : Result := AnsiChar(byte(V)); varString : Result := AnsiString(V); varArray : Result := VarArrayToStr(Variant(V)); end; end; var i : integer; begin Result := '['; if (VarType(vArray) and VarArray)=0 then Result := _VarToStr(vArray) else for i := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do if i=VarArrayLowBound(vArray, 1) then Result := Result+_VarToStr(vArray[i]) else Result := Result+'|'+_VarToStr(vArray[i]); Result:=Result+']'; end; function VarStrNull(const V:OleVariant):AnsiString; //avoid problems with null strings begin Result:=''; if not VarIsNull(V) then begin if VarIsArray(V) then Result:=VarArrayToStr(V) else Result:=AnsiString(VarToStr(V)); end; end; { THardwareId } constructor THardwareId.Create(Generate:Boolean=True); begin inherited Create; CoInitialize(nil); FBuffer :=''; //Set the propeties to be used in the hardware id generation FMotherBoardInfo :=[Mb_SerialNumber,Mb_Manufacturer,Mb_Product,Mb_Model]; FOSInfo :=[Os_BuildNumber,Os_BuildType,Os_Manufacturer,Os_Name,Os_SerialNumber,Os_Version]; FBIOSInfo :=[Bs_BIOSVersion,Bs_BuildNumber,Bs_Description,Bs_Manufacturer,Bs_Name,Bs_SerialNumber,Bs_Version]; FProcessorInfo :=[];//including the processor info is expensive [Pr_Description,Pr_Manufacturer,Pr_Name,Pr_ProcessorId,Pr_UniqueId]; if Generate then GenerateHardwareId; end; destructor THardwareId.Destroy; begin CoUninitialize; inherited; end; //Main function which collect the system data. procedure THardwareId.GenerateHardwareId; var objSWbemLocator : OLEVariant; objWMIService : OLEVariant; objWbemObjectSet: OLEVariant; oWmiObject : OLEVariant; oEnum : IEnumvariant; iValue : LongWord; SDummy : AnsiString; Mb : TMotherBoardInfo; Os : TOSInfo; Bs : TBIOSInfo; Pr : TProcessorInfo; begin; objSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator'); objWMIService := objSWbemLocator.ConnectServer('localhost','root\cimv2', '',''); if FMotherBoardInfo<>[] then //MotherBoard info begin objWbemObjectSet:= objWMIService.ExecQuery('SELECT * FROM Win32_BaseBoard','WQL',0); oEnum := IUnknown(objWbemObjectSet._NewEnum) as IEnumVariant; while oEnum.Next(1, oWmiObject, iValue) = 0 do begin for Mb := Low(TMotherBoardInfo) to High(TMotherBoardInfo) do if Mb in FMotherBoardInfo then begin SDummy:=VarStrNull(oWmiObject.Properties_.Item(MotherBoardInfoArr[Mb]).Value); FBuffer:=FBuffer+SDummy; end; oWmiObject:=Unassigned; end; end; if FOSInfo<>[] then//Windows info begin objWbemObjectSet:= objWMIService.ExecQuery('SELECT * FROM Win32_OperatingSystem','WQL',0); oEnum := IUnknown(objWbemObjectSet._NewEnum) as IEnumVariant; while oEnum.Next(1, oWmiObject, iValue) = 0 do begin for Os := Low(TOSInfo) to High(TOSInfo) do if Os in FOSInfo then begin SDummy:=VarStrNull(oWmiObject.Properties_.Item(OsInfoArr[Os]).Value); FBuffer:=FBuffer+SDummy; end; oWmiObject:=Unassigned; end; end; if FBIOSInfo<>[] then//BIOS info begin objWbemObjectSet:= objWMIService.ExecQuery('SELECT * FROM Win32_BIOS','WQL',0); oEnum := IUnknown(objWbemObjectSet._NewEnum) as IEnumVariant; while oEnum.Next(1, oWmiObject, iValue) = 0 do begin for Bs := Low(TBIOSInfo) to High(TBIOSInfo) do if Bs in FBIOSInfo then begin SDummy:=VarStrNull(oWmiObject.Properties_.Item(BiosInfoArr[Bs]).Value); FBuffer:=FBuffer+SDummy; end; oWmiObject:=Unassigned; end; end; if FProcessorInfo<>[] then//CPU info begin objWbemObjectSet:= objWMIService.ExecQuery('SELECT * FROM Win32_Processor','WQL',0); oEnum := IUnknown(objWbemObjectSet._NewEnum) as IEnumVariant; while oEnum.Next(1, oWmiObject, iValue) = 0 do begin for Pr := Low(TProcessorInfo) to High(TProcessorInfo) do if Pr in FProcessorInfo then begin SDummy:=VarStrNull(oWmiObject.Properties_.Item(ProcessorInfoArr[Pr]).Value); FBuffer:=FBuffer+SDummy; end; oWmiObject:=Unassigned; end; end; end; function THardwareId.GetHardwareIdHex: AnsiString; begin SetLength(Result,Length(FBuffer)*2); BinToHex(PAnsiChar(FBuffer),PAnsiChar(Result),Length(FBuffer)); end; {$IFDEF Use_Jwscl} function THardwareId.GetHashString(Algorithm: TJwHashAlgorithm; Buffer : Pointer;Size:Integer) : AnsiString; var Hash: TJwHash; HashSize: Cardinal; HashData: Pointer; begin Hash := TJwHash.Create(Algorithm); try Hash.HashData(Buffer,Size); HashData := Hash.RetrieveHash(HashSize); try SetLength(Result,HashSize*2); BinToHex(PAnsiChar(HashData),PAnsiChar(Result),HashSize); finally TJwHash.FreeBuffer(HashData); end; finally Hash.Free; end; end; function THardwareId.GetHardwareIdMd2: AnsiString; begin Result:=GetHashString(haMD2,@FBuffer[1],Length(FBuffer)); end; function THardwareId.GetHardwareIdMd4: AnsiString; begin Result:=GetHashString(haMD4,@FBuffer[1],Length(FBuffer)); end; function THardwareId.GetHardwareIdMd5: AnsiString; begin Result:=GetHashString(haMD5,@FBuffer[1],Length(FBuffer)); end; function THardwareId.GetHardwareIdSHA: AnsiString; begin Result:=GetHashString(haSHA,@FBuffer[1],Length(FBuffer)); end; {$ENDIF} //testing the THardwareId object var HWID : THardwareId; dt : TDateTime; begin try HWID:=THardwareId.Create(False); try dt := Now; HWID.GenerateHardwareId; dt := now - dt; Writeln(Format('Hardware Id Generated in %s',[FormatDateTime('hh:mm:nn.zzz',dt)])); Writeln(Format('%s %s',['Buffer ',HWID.Buffer])); Writeln(''); Writeln(Format('%s %s',['Hex ',HWID.HardwareIdHex])); {$IFDEF Use_Jwscl} Writeln(Format('%s %s',['Md2 ',HWID.HardwareIdMd2])); Writeln(Format('%s %s',['Md4 ',HWID.HardwareIdMd4])); Writeln(Format('%s %s',['Md5 ',HWID.HardwareIdMd5])); Writeln(Format('%s %s',['SHA1 ',HWID.HardwareIdSHA])); {$ENDIF} Readln; finally HWID.Free; end; except on E:Exception do begin Writeln(E.Classname, ':', E.Message); Readln; end; end; end.
December 2, 2010 at 4:44 am
I have done the same, collecting 3 serial numbers and linking their hash to the registration, but with one addition:
If only one of those 3 changes, we assume a hardware update and silently update the hash/registration ‘behind the scenes’, so that the user is not bothered by it.
Jan
December 2, 2010 at 12:55 pm
Works fine on Delphi 7. I undefine the jedi security stuff. Having the Hex string, allows you to do many things.
Pingback: Tweets that mention Generating a “unique” hardware ID using delphi and the WMI « The Road to Delphi – a Blog About Delphi Programming (mostly) -- Topsy.com
November 14, 2011 at 5:21 am
Hola Rodrigo, busco algo así que pueda implementar en mi soft, pero no entiendo mucho como instalarlo o como usarlo. Uso actualmente los componentes de Neftali que son similares. Pero me tarda mucho en PCs viejas para arrancar el sistema, me envias por email
una sencilla explicacion o un ejemplo practico de uso si serias tan amable por favor.
Desde ya muchisimas gracias!
November 14, 2011 at 10:45 am
Hola Walter, indicame que parte del codigo no entiendes o te genera dudas.
November 21, 2011 at 11:20 am
Hola, disculpas por el tiempo!. Habia perdido el link del sitio y recien lo encontre.
Uso las propiedades:
DiskDriveProperties.Signature de TDiskDriveInfo
ProcessorProperties.ProcessorID de TProcessorInfo
Estos componentes me devuelven dos cadenas que las encripto y demas para generar
un unico id de la pc y en base a eso generar una clave de activacion del producto. Todo muy bien, pero es mucho el tiempo que lleva en recolectar toda la información de los componentes, ya que son muchas propiedades que posee, practicamente todo el procesador y disco.
Yo uso unicamente esas dos propiedades de los 2 componentes, por eso queria ver la posibilidad de extraer esas mismas por otro medio, vi que lees informacion del procesador pero no del disco, no importa se puede reemplazar, pero nose como implementar este codigo en mi aplicacion, probe agregando al proyecto pero no me da opcion de uso y saltan errores como por ej. de falta de unit e interface. Estoy con Delphi 2010.
Se podria obtener unicamente dos ID de una forma mas sencilla, por ej. procesador y mother?, o como poner este codigo en una unit y usarlo normalmente.
Eso seria todo mi problema, desde ya muchisimas gracias!
November 27, 2011 at 3:31 am
Just looking for it, many thanks for the code! Tested it, and works fine on Delphi 2010.
Pingback: Bios, Motherboard unter Win7 64? - Delphi-PRAXiS
March 30, 2014 at 8:30 am
can you add the sample code for this article in a zip file?
i got about 25 error when tried to run this :|
thank you
March 30, 2014 at 8:31 am
im working with xe5…
March 31, 2014 at 8:58 pm
The code works just fine in XE5, try disabling the Use_Jwscl define.
Pingback: Anonymous