Seriennummer der Systemplatte...

[DelphiSecurity]

Mich würde der Quellcode auch interessieren.

[hathor]

Delphi-Quellcode:

function GetIdeHddSn: string;
const
    IDENTIFY_BUFFER_SIZE = 512;
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;
    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;
        dwReserved: array [0..3] of DWORD;
        bBuffer: array [0..0] of Byte; // Input buffer.
    end;
    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;
    TDriverStatus = packed record
        bDriverError: Byte; 
        bIDEStatus: Byte;     // IDE SMART_IDE_ERROR
        bReserved: array [0..1] of Byte;
        dwReserved: array [0..1] of DWORD;
    end;
    TSendCmdOutParams = packed record
        cBufferSize: DWORD;           // bBuffer
        DriverStatus: TDriverStatus;                       
        bBuffer: array [0..0] of BYTE;
    end;

var
    hDevice              : THandle;
    cbBytesReturned      : DWORD;
    SCIP                 : TSendCmdInParams;
    aIdOutCmd            : array [0..( SizeOf( TSendCmdOutParams ) +
        IDENTIFY_BUFFER_SIZE -
        1 ) - 1] of Byte;
    IdOutCmd             : TSendCmdOutParams absolute aIdOutCmd;

    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;

begin
    Result := '';                                           
    if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
    begin
        // '\\.\PhysicalDrive1\'
        hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or
            GENERIC_WRITE,
            FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
    end
    else // Version Windows 95 OSR2, Windows 98
        hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
    if hDevice = INVALID_HANDLE_VALUE then
        Exit;
    try
        FillChar( SCIP, SizeOf( TSendCmdInParams ) - 1, #0 );
        FillChar( aIdOutCmd, SizeOf( aIdOutCmd ), #0 );
        cbBytesReturned := 0;
        // Set up data structures for IDENTIFY command.
        with SCIP do
        begin
            cBufferSize := IDENTIFY_BUFFER_SIZE; // bDriveNumber := 0;
            with irDriveRegs do
            begin
                bSectorCountReg := 1;
                bSectorNumberReg := 1;
                // if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
                // else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
                bDriveHeadReg := $A0;
                bCommandReg := $EC;
            end;
        end;
        if not DeviceIoControl( hDevice, $0007C088, @SCIP, SizeOf(
            TSendCmdInParams ) - 1,
            @aIdOutCmd, SizeOf( aIdOutCmd ), cbBytesReturned, nil ) then
            Exit;
    finally
        CloseHandle( hDevice );
    end;
    with PIdSector( @IdOutCmd.bBuffer )^ do
    begin
        ChangeByteOrder( sSerialNumber, SizeOf( sSerialNumber ) );
        ( PChar( @sSerialNumber ) + SizeOf( sSerialNumber ) )^ := #0;
        Result := PChar( @sSerialNumber );
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption:= GetIdeHddSn;
end;

[Joerginger]

Ich danke herzlich für die CodeSpende(n)!

GLG, Joerginger

[user0815]

google code search findet auch genau diese function: http://www.google.com/codesearch?as_...ense=&as_case=

[Chriscode]

Zitat von hathor:

function GetIdeHddSn: string;

Also es ist mir etwas unangenehm den Thread wieder auszugraben aber da ich die hier gepostete Funktion nicht zum Laufen bekomme ist es womöglich auch für andere interessant die auf dieses Thema stoßen.

Ich möchte genau wie der TE die Seriennummer der Systemplatte auslesen. Und das ganze zuverlässig und auch für Vista und Windows 7.

Problem: Wenn ich die Prozedur so wie geposted per c&p übernehme erhalte ich als Seriennummer nur Sonderzeichen. System windows xp.

Woran könnte das liegen? Und ist die Prozedur überhaupt geeignet auf jedem System zuverlässig zu arbeiten? Oder sollte man zur "Erkennung" des Systems besser die SID nehmen?

Ich habe etwas Angst das die Seriennummer z.B. nicht bei jeder Festplatte vorhanden ist oder nicht bei jedem System ausgelesen werden kann und es so zu Problemen kommt.

Besten Dank,

Gruß
Chris

[mkinzler]

Unicodeproblem?