1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:

.
.
.
var
  Form1: TForm1;

Type  
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; 
  IDEREGS   = TIDERegs; 
  PIDERegs  = ^TIDERegs; 

TIdSector = packed record 
    wGenConfig                 : Word; //00 
    wNumCyls                   : Word; 
    wReserved                  : Word; 
    wNumHeads                  : Word; 
    wBytesPerTrack             : Word; 
    wBytesPerSector            : Word; 
    wSectorsPerTrack           : Word; 
    wVendorUnique              : Array[0..2] of Word; 
    sSerialNumber              : Array[0..19] of Char; //10-19 
    wBufferType                : Word; 
    wBufferSize                : Word; 
    wECCSize                   : Word; 
    sFirmwareRev               : Array[0..7] of Char;  //23-26 
    sModelNumber               : Array[0..39] of Char; //27-46 
    wMoreVendorUnique          : Word; 
    wDoubleWordIO              : Word; 
    wCapabilities              : Word; 
    wReserved1                 : Word; 
    wPIOTiming                 : Word; 
    wDMATiming                 : Word; 
    wBS                        : Word; 
    wNumCurrentCyls            : Word; 
    wNumCurrentHeads           : Word; 
    wNumCurrentSectorsPerTrack : Word; 
    ulCurrentSectorCapacity    : ULONG; //57-58 
    wMultSectorStuff           : Word; 
    ulTotalAddressableSectors  : ULONG; //60-61 
    wSingleWordDMA             : Word; 
    wMultiWordDMA              : Word;  //63 
    wFlowControlPIOSupported   : Word;  //64 
    wMinimumMultiWordDMA       : Word;  //65 
    wRecommendedMultiWordDMA   : Word;  //66 
    wMinimumPIOCycleWOFlow     : Word;  //67 
    wMinimumPIOCycleIORDYFlow  : Word;  //68 
    bReserved1                 : Array[0..21] of Byte; //69-79 
    wMajorVersionNumber        : Word;  //80 
    wMinorVersionNumber        : Word;  //81 
    wCommandSetSupported       : Word;  //82 
    wCommandSetSupported2      : Word;  //83 
    wCommandSetExtension       : Word;  //84 
    wCommandSetFeatureEnabled1 : Word;  //85 
    wCommandSetFeatureEnabled2 : Word;  //86 
    wCommandSetFeatureEnabled3 : Word;  //87 
    wUltraDMAMode              : Word;  //88 
    wTimeRequiredErase         : Word;  //89 
    wTimeRequiredEnhancedErase : Word;  //90 
    wAbleMode                  : Word;  //91 
    bReserved2                 : Array[0..71] of Byte; //92-127 
    wSecurityModeFeature       : Word;  //128 
    wCurrentFeatureOption      : Word;  //129 
    wReserved2                 : Word;  //130 
    wInitialPowerMode          : Word;  //131 
    bReserved3                 : Array[0..247] of Byte; //132-255 
  end; 
  PIdSector = ^TIdSector;

 const 
  BufferSize = SizeOf(TIDERegs)+4; 
  IOCTL_IDE_PASS_THROUGH        = $0004d028;


implementation

{$R *.dfm}

Function IdeRegPassThrough(Device: String; var ideregs: TIDERegs ): Boolean; 
var 
  ret:BOOL; 
  hDevice : THandle; 
  cbBytesReturned : DWORD; 
  pInData : PIDERegs; 
  pOutData : Pointer; 
  Buffer : Array[0..BufferSize-1] of Byte; 
begin 
  Result := False; 
  FillChar(Buffer,BufferSize,#0); 

  hDevice := CreateFile( PChar(Device), GENERIC_READ or GENERIC_WRITE, 
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 ); 
  if hDevice=INVALID_HANDLE_VALUE then Exit; 
  try 
    pInData := @Buffer; 
     pOutData := pInData; 
    pInData^ := ideregs; 
    ret := DeviceIoControl( hDevice, IOCTL_IDE_PASS_THROUGH, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil ); 
    if not ret then begin 
      Exit; 
    end; 
    ideregs := PIDERegs(pOutData)^; 
  finally 
    CloseHandle(hDevice); 
  end; 
  Result := True; 
end; 

function GetSerialNumber(const ADrive: Char): Integer;
var
  SerialNum: DWORD;
  Dummy: DWord;
  Buffer: array[0..255] of Char;
begin
  Result := 0;
  if GetVolumeInformation(PChar(ADrive+':\'),
     Buffer, SizeOf(Buffer), @SerialNum, Dummy, Dummy, nil, 0) then
    Result:=SerialNum
  else
    RaiseLastOSError;
end;

function GetHardDiskSerial(const DriveLetter: Char): string;
var
  NotUsed:     DWORD;
  VolumeFlags: DWORD;
  VolumeInfo:  array[0..MAX_PATH] of Char;
  VolumeSerialNumber: DWORD;
begin
  GetVolumeInformation(PChar(DriveLetter + ':\'),
    nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
    VolumeFlags, nil, 0);
  Result := Format('Label: %s,VolSer: %8.8X',[VolumeInfo, VolumeSerialNumber])
//  ShowMessage(GetHardDiskSerial('c'));
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

function SendToSleep(Device: String): Boolean;
var 
  ideregs : TIDERegs; 
begin 
  Result := False; 
  with ideregs do 
  begin 
    bFeaturesReg     := 0; 
    bSectorCountReg  := 0; 
    bSectorNumberReg := 0; 
    bCylLowReg       := 0; 
    bCylHighReg      := 0; 
    bDriveHeadReg    := $A0; 
    bCommandReg      := $E6; 
    bReserved        := 0; 
  end; 
  if not IdeRegPassThrough(Device, ideregs ) then Exit else Result := True; 
end;
//BoolToStr(SendToSleep('\\.\PhysicalDrive1'));
//BoolToStr(SendToSleep('\\.\PhysicalDrive0'));                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

procedure tform1.PrintIdSectorInfo( IdSector : TIdSector );
var szOutBuffer : Array [0..40] of Char;
begin
{$ifdef debug}
OutputDebugString('PrintIdSectorInfo');
{$endif}

  with IdSector do
  begin
    ChangeByteOrder( sModelNumber, SizeOf(sModelNumber) ); // Change the WORD array to a BYTE array
    szOutBuffer[SizeOf(sModelNumber)] := #0;
    StrLCopy( szOutBuffer, sModelNumber, SizeOf(sModelNumber) );
    label1.caption :='Model :                     ' + szOutBuffer ;

    ChangeByteOrder( sFirmwareRev, SizeOf(sFirmwareRev) );
    szOutBuffer[SizeOf(sFirmwareRev)] := #0;
    StrLCopy( szOutBuffer, sFirmwareRev, SizeOf(sFirmwareRev) );
    label2.caption := 'Firmware Rev :         ' + szOutBuffer ;

    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
    szOutBuffer[SizeOf(sSerialNumber)] := #0;
    StrLCopy( szOutBuffer, sSerialNumber, SizeOf(sSerialNumber) );
    label3.caption :=  'Serial Number :  '+ szOutBuffer ;
  end;
{$ifdef debug}
OutputDebugString('PrintIdSectorInfo end');
{$endif}
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

procedure tform1.DirectIdentify;
var hDevice : THandle;
    rc : DWORD;
    nIdSectorSize : LongInt;
    aIdBuffer : Array [0..IDENTIFY_BUFFER_SIZE-1] of Byte;
    IdSector : TIdSector absolute aIdBuffer;
begin
  FillChar(aIdBuffer,SizeOf(aIdBuffer),#0);
  hDevice := GetPhysicalDriveHandle( 0, GENERIC_READ or GENERIC_WRITE );                    

1:

hDevice := GetPhysicalDriveHandle( 0, GENERIC_READ or GENERIC_WRITE )