Delphi-PRAXiS - Delphi Seriennummer der Systemplatte...

Zitat:
Zitat von Luckie (Beitrag 1163933)
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.