unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Windows,
Forms,
StdCtrls;
type
{ TForm1 }
TForm1 =
class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
OSVersionInfo: TOSVersionInfo;
const IDENTIFY_BUFFER_SIZE = 512;
// SMART IOCTL commands
DFP_GET_VERSION = $00074080;
DFP_SEND_DRIVE_COMMAND = $0007c084;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IDE_ATAPI_ID = $A1;
// Returns ID sector for ATAPI.
IDE_ID_FUNCTION = $
EC;
// Returns ID sector for ATA.
IDE_EXECUTE_SMART_FUNCTION = $B0;
// Performs SMART cmd. Requires valid bFeaturesReg, bCylLowReg, and bCylHighReg
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;
LPIDERegs = PIDERegs;
_IDEREGS = TIDERegs;
type
TIdSector =
packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique :
Array[0..2]
of Word;
sSerialNumber :
Array[0..19]
of CHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev :
Array[0..7]
of Char;
sModelNumber :
Array[0..39]
of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved :
Array[0..127]
of BYTE;
end;
PIdSector = ^TIdSector;
type
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;
DRIVERSTATUS = TDriverStatus;
PDriverStatus = ^TDriverStatus;
LPDriverStatus = TDriverStatus;
_DRIVERSTATUS = TDriverStatus;
type
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;
SENDCMDOUTPARAMS = TSendCmdOutParams;
PSendCmdOutParams = ^TSendCmdOutParams;
LPSendCmdOutParams = PSendCmdOutParams;
_SENDCMDOUTPARAMS = TSendCmdOutParams;
type
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;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;
LPSendCmdInParams = PSendCmdInParams;
_SENDCMDINPARAMS = TSendCmdInParams;
implementation
{$R *.lfm}
//--------------------------------------------------------------------------------------------------------------------------
(* asm kennt LAZARUS nicht
function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
MOV EBX,ECX
XOR AL,AL
TEST ECX,ECX
JZ @@1
REPNE SCASB
JNE @@1
INC ECX
@@1: SUB EBX,ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,EDI
MOV ECX,EBX
SHR ECX,2
REP MOVSD
MOV ECX,EBX
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
end;
*)
function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar;
var
Count: Cardinal;
begin
// copies a specified maximum number of characters from Source to Dest
Result := Dest;
Count := 0;
While (Count < MaxLen)
and (Source^ <> #0)
do begin
Dest^ := Source^;
Inc(Source);
Inc(Dest);
Inc(Count);
end;
Dest^ := #0;
end;
/// <description> copies a specified maximum number of characters from Source to Dest </description>
function StrLCopy3(Dest, Source: PChar; MaxLen: UInt64): PChar;
begin
Dec(MaxLen);
// für die abschließende #0
if Int64(MaxLen) < 0
then
Exit(
nil);
Result := Dest;
while (MaxLen > 0)
and (Source^ <> #0)
do begin
Dest^ := Source^;
Inc(Source);
Inc(Dest);
Dec(MaxLen);
end;
Dest^ := #0;
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 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 );
Result := CreateFile( PChar('
\\.\PhysicalDrive'+S), DesireAccess, FILE_SHARE_READ,
nil, OPEN_EXISTING, 0, 0 );
end
else // Windows 95 OSR2, Windows 98
Result := CreateFile( '
\\.\SMARTVSD', 0, 0,
nil, CREATE_NEW, 0, 0 );
end;
procedure PrintIdSectorInfo( IdSector : TIdSector );
var szOutBuffer :
Array [0..40]
of Char;
begin
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) );
Form1.label1.caption :='
Model : ' + szOutBuffer ;
ChangeByteOrder( sFirmwareRev, SizeOf(sFirmwareRev) );
szOutBuffer[SizeOf(sFirmwareRev)] := #0;
StrLCopy( szOutBuffer, sFirmwareRev, SizeOf(sFirmwareRev) );
Form1.label2.caption := '
Firmware Rev : ' + szOutBuffer ;
ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
szOutBuffer[SizeOf(sSerialNumber)] := #0;
StrLCopy( szOutBuffer, sSerialNumber, SizeOf(sSerialNumber) );
Form1.label3.caption := '
Serial Number : '+ szOutBuffer ;
end;
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;
procedure 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 );
// hDevice := GetPhysicalDriveHandle( 0, GENERIC_READ ); <-- geht NICHT
if hDevice=INVALID_HANDLE_VALUE
then
begin
//rc := GetLastError;
end
else
try
if not SmartIdentifyDirect( hDevice, 0, IDE_ID_FUNCTION, IdSector, nIdSectorSize )
then
begin
//rc := GetLastError;
end
else
begin
//ShowMessage('SMART IDENTIFY command is completed successfully.');
PrintIdSectorInfo(IdSector);
end;
finally
CloseHandle(hDevice);
end;
end;
{ TForm1 }
procedure TForm1.FormShow(Sender: TObject);
begin
DirectIdentify;
end;
end.