Link to home
Start Free TrialLog in
Avatar of s_arb
s_arb

asked on

Making Software Lock according to hardware unique information

Hi

   I want to Add a software lock to my program.
Before,I used Serial number of hard drive.but know i see
if you format the hard disk it's serial number is changing.
Is there another unique information on any part of hardware(for example serial number of CPU,but i don't know how to read it),My program is running on Win98/2000/XP.
If you have suggestion,Please give me code or component to
do that.

  Thanks
Avatar of ferhad
ferhad
Flag of Azerbaijan image

hi s_arb
Look at the following URL:
https://www.experts-exchange.com/questions/20803727/Get-processor-ID-or-Motherboard-ID.html

Hope this short answer will help you
I can extract the real physical serial number of hard drive, but only works under Windows XP
Avatar of Sergio_Hdez
Sergio_Hdez

You can store a hole branch of the registry where id numbers of hardware are stored in a text crypted file, then, once you open your app, check the registry with this file lines and, if 60% (or more) of old lines are present on the registry, it is the same machine, but if not 60% of them are in this system, it is a different system with different hardware devices.

I assume a reinstall will produce a similar set of IDs on same hardware... it have to be tested, by I will not format and reinstall my PC several times just for points ;)

Changing from 60% to a less restrictive % can make it work after a windows reinstall (if it doesn't work with 60%), but still prevent using this file on other system.

Just need to be tested on different machines and after reinstalling those machines, then check the files to see the number of lines unchanged after reinstall and in different machines... this will give the right % to use.
Avatar of s_arb

ASKER

esoftbg
  Can you show me your code?
I suppose it will work on win2000 too.
unit Unit_Q_20950704;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, DBT, StdCtrls;

const
      IDE_ID_FUNCTION            = $EC; // Returns ID sector for ATA.
      CAP_IDE_ID_FUNCTION        = 1;   // ATAPI ID command supported
      IDENTIFY_BUFFER_SIZE       = 512;
      DFP_RECEIVE_DRIVE_DATA     = $0007c088;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    procedure SpeedButton1Click(Sender: TObject);
  private   { Private declarations }
  public    { Public declarations }
    function  Physical_SN(Id: Integer): Int64;
  end;

      USHORT = Word;
  TIdBuffer    = array [0..IDENTIFY_BUFFER_SIZE-1] of Byte;
      TGetVersionOutParams = packed record
            bVersion      : BYTE;                 // Binary driver version.
            bRevision     : BYTE;                 // Binary driver revision.
            bReserved     : BYTE;                 // Not used.
            bIDEDeviceMap : BYTE;                 // Bit map of IDE devices.
            fCapabilities : DWORD;                // Bit mask of driver capabilities.
            dwReserved    : Array[0..3] of DWORD; // For future use.
      end;

      TIdSector = packed record
            wGenConfig                 : USHORT;
            wNumCyls                   : USHORT;
            wReserved                  : USHORT;
            wNumHeads                  : USHORT;
            wBytesPerTrack             : USHORT;
            wBytesPerSector            : USHORT;
            wSectorsPerTrack           : USHORT;
            wVendorUnique              : Array[0..2] of USHORT;
            sSerialNumber              : Array[0..19] of CHAR;
            wBufferType                : USHORT;
            wBufferSize                : USHORT;
            wECCSize                   : USHORT;
            sFirmwareRev               : Array[0..7] of CHAR;
            sModelNumber               : Array[0..39] of CHAR;
            wMoreVendorUnique          : USHORT;
            wDoubleWordIO              : USHORT;
            wCapabilities              : USHORT;
            wReserved1                 : USHORT;
            wPIOTiming                 : USHORT;
            wDMATiming                 : USHORT;
            wBS                        : USHORT;
            wNumCurrentCyls            : USHORT;
            wNumCurrentHeads           : USHORT;
            wNumCurrentSectorsPerTrack : USHORT;
            ulCurrentSectorCapacity    : ULONG;
            wMultSectorStuff           : USHORT;
            ulTotalAddressableSectors  : ULONG;
            wSingleWordDMA             : USHORT;
            wMultiWordDMA              : USHORT;
            bReserved                  : Array[0..127] of BYTE;
      end;

      TDriverStatus = packed record
            bDriverError : Byte;                 // Error code from driver, or 0 if no error.
            bIDEStatus   : Byte;                 // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.
            bReserved    : Array[0..1] of Byte;  // Reserved for future expansion.
            dwReserved   : Array[0..1] of DWORD; // Reserved for future expansion.
      end;

      TSendCmdOutParams = packed record
            cBufferSize  : DWORD;               // Size of bBuffer in bytes
            DriverStatus : TDriverStatus;       // Driver status structure.
            bBuffer      : Array[0..0] of BYTE; // Buffer of arbitrary length in which to store the data read from the drive.
      end;

      TIDERegs = packed record
            bFeaturesReg     : BYTE; // Used for specifying SMART "commands".
            bSectorCountReg  : BYTE; // IDE sector count register
            bSectorNumberReg : BYTE; // IDE sector number register
            bCylLowReg       : BYTE; // IDE low order cylinder value
            bCylHighReg      : BYTE; // IDE high order cylinder value
            bDriveHeadReg    : BYTE; // IDE drive/head register
            bCommandReg      : BYTE; // Actual IDE command.
            bReserved        : BYTE; // reserved for future use.  Must be zero.
      end;

      TSendCmdInParams = packed record
            cBufferSize  : DWORD;                // Buffer size in bytes
            irDriveRegs  : TIDERegs;             // Structure with drive register values.
            bDriveNumber : BYTE;                 // Physical drive number to send command to (0,1,2,3).
            bReserved    : Array[0..2] of Byte;  // Reserved for future expansion.
            dwReserved   : Array[0..3] of DWORD; // For future use.
            bBuffer      : Array[0..0] of Byte;  // Input buffer.
      end;

var
  Form1: TForm1;

var
  aIdBuffer: TIdBuffer;
  Id_Sector: TIdSector absolute aIdBuffer;
function  DirectIdentify(I: DWORD): Boolean;

implementation

{$R *.dfm}

var
  OSVersionInfo: TOSVersionInfo;

function GetPhysicalDriveHandle(DriveNum: Byte; DesireAccess: ACCESS_MASK): THandle;
var
  S:     string;
begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if OSVersionInfo.dwPlatformId=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
  begin
    Str(DriveNum,s); // avoid SysUtils
    Result := CreateFile( PChar('\\.\PhysicalDrive'+S), DesireAccess, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
  end
  else // Windows 95 OSR2, Windows 98
    Result := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
  {$ifdef debug}
  if Result=INVALID_HANDLE_VALUE then
    OutputDebugString(PChar('Error on CreateFile: '+SysErrorMessage(GetLastError)));
  {$endif}
end;

function SmartIdentifyDirect( hDevice : THandle; bDriveNum : Byte; bIDCmd : Byte; var IdSector : TIdSector; var IdSectorSize : LongInt ) : BOOL;
const
  BufferSize = SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1;
var
  SCIP:        TSendCmdInParams;
             Buffer : Array [0..BufferSize-1] of Byte;
             SCOP : TSendCmdOutParams absolute Buffer;
             dwBytesReturned : DWORD;
begin
  FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
  FillChar(Buffer,BufferSize,#0);
  dwBytesReturned := 0;
  IdSectorSize := 0;
  // Set up data structures for IDENTIFY command.
  with SCIP do
  begin
    cBufferSize  := IDENTIFY_BUFFER_SIZE;
    bDriveNumber := bDriveNum;
    with irDriveRegs do
    begin
      bFeaturesReg     := 0;
      bSectorCountReg  := 1;
      bSectorNumberReg := 1;
      bCylLowReg       := 0;
      bCylHighReg      := 0;
      bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
      bCommandReg      := bIDCmd;      // The command can either be IDE identify or ATAPI identify.
    end;
  end;
  Result := DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, @SCIP, SizeOf(TSendCmdInParams)-1, @SCOP, BufferSize, dwBytesReturned, nil );
  if Result then
  begin
    IdSectorSize := dwBytesReturned-SizeOf(TSendCmdOutParams)+1;
    if IdSectorSize<=0 then IdSectorSize := 0 else System.Move(SCOP.bBuffer,IdSector,IdSectorSize);
  end;
end;

function  DirectIdentify(I: DWORD): Boolean;
var
  B:               Boolean;
  hDevice:         THandle;
  nIdSectorSize:   LongInt;
begin
  B := False;
  FillChar(aIdBuffer, SizeOf(aIdBuffer), #0);
  try
    hDevice := GetPhysicalDriveHandle(I, GENERIC_READ or GENERIC_WRITE);
    try
      {$ifdef debug}
      OutputDebugString(PChar('GetPhysicalDriveHandle return '+IntToHex(hDevice,8)));
      {$endif}
      if (hDevice<>INVALID_HANDLE_VALUE) then
      try
        B := SmartIdentifyDirect(hDevice, 0, IDE_ID_FUNCTION, Id_Sector, nIdSectorSize);
      finally
        {$ifdef debug}
        OutputDebugString('PrintIdSectorInfo end');
        {$endif}
      end;
    finally
      Result := B;
      CloseHandle(hDevice);
    end;
  except
    Result := False;
  end;
end;

function  Hex_To_Dec(S: string): Int64;
var
  C:      Char;
  J:      Integer;
  II:     Int64;
  IH:     Int64;
begin
  IH := 0;
  try
    II := 1;
    while (S<>'') do
    begin
      C := S[Length(S)];
      if (C in ['0'..'9']) then
        J := StrToInt(C)
      else
        J := Ord(C) - 55;
      IH := IH + II * J;
      Delete(S,Length(S),1);
      II := II * 16;
    end;
  finally
    Result := IH;
  end;
end;

procedure ChangeByteOrder( var Data; Size : Integer );
var
  ptr:    PChar;
  i:      Integer;
  c:      Char;
begin
  ptr := @Data;
  for i := 0 to (Size shr 1)-1 do
  begin
    c := ptr^;
    ptr^ := (ptr+1)^;
    (ptr+1)^ := c;
    Inc(ptr,2);
  end;
end;

function  TForm1.Physical_SN(Id: Integer): Int64;
type
  TacOutBuffer  =  array[0..40] of Char;
var
  I:               Integer;
  IH:              Int64;
  acOutBuffer:     TacOutBuffer;
  T:               string;
begin
  IH := 0;
  try
    DirectIdentify(Id);
    //................................
    with Id_Sector do
    begin
      ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
      acOutBuffer[SizeOf(sSerialNumber)] := #0;
      StrLCopy(acOutBuffer, sSerialNumber, SizeOf(sSerialNumber));
      I := 0;
      T := '';
      while (acOutBuffer[I] in [#32..#127]) do
      begin
        T := T + acOutBuffer[I];
        Inc(I);
      end;
      T := Trim(T);
      Memo1.Lines.Add(Char(Id+67) + ':');
      Memo1.Lines.Add('Hex. Serial num:' + T);
      IH := Hex_To_Dec(T);
      Memo1.Lines.Add('Dec. Serial num:' + IntToStr(IH));
    end;
  finally
    Result := IH;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Physical_SN(0); // C:
  Physical_SN(1); // D:
  Physical_SN(2); // E:
end;

end.
Avatar of s_arb

ASKER

esoftbg
 
   So ,If we format for instance Volume C,it's physical serial number
will not change?

    Finally,If someone helps me to find a code for getting physical
serial number in Win98 ,my problem will be solved.
Hi s_arb,
I am absolutely sure that above function extracts physical SN from HDD's, because I have been formated my HDD's many times, but the  physical SN is the same. Even more: I have a warranty card for my new HDD from the shop I buyed it where  the  physical SN is wroten and it is the same....
Avatar of s_arb

ASKER

My program is working on win98 too.
How can i find HD serial number there.
ASKER CERTIFIED SOLUTION
Avatar of esoftbg
esoftbg
Flag of Bulgaria image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
this link was accepted as there is a solution:
http://www.delphipages.com/threads/thread.cfm?ID=78593&G=78520