Seriennummer der Systemplatte...

[hathor]

Zitat von Luckie:

Aber doch nicht, um die Seriennummer auszulesen.

GetPhysicalDriveHandle ist das Problem. Es braucht Administrator-Rechte bei WIN 7.

Test-Programm im Anhang.

Delphi-Quellcode:

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.