Windows7 Delphi obtiene el número de serie del disco duro y el número de serie físico

unidad Unidad1;

interfaz

usos

Windows, Mensajes, SysUtils, Variantes, Clases, Gráficos, Controles, Formularios,

Diálogos, StdCtrls;

tipo

TForm1 = clase(TForm)

Editar1: TEdit;

Botón1 : TButton;

procedimiento Button1Click(Remitente: TObject);

procedimiento Button2Click(Remitente: TObject);

privado

{ Privado declaraciones }

public

{ Declaraciones públicas }

end;

var

Form1: TForm1;

implementación

{$R *.dfm}

procedimiento TForm1.Button1Click(Sender: TObject);

comenzar

end;

//Obtener el número de serie del disco duro

función GetIdeSerialNumber: pchar;

const IDENTIFY_BUFFER_SIZE = 512;

tipo

TIDERegs = registro empaquetado

bFeaturesReg: BYTE; // Se utiliza para especificar "comandos" SMART.

bSectorCountReg: BYTE; registro

bSectorNumberReg: BYTE; // registro de número de sector IDE

bCylLowReg: BYTE; // valor del cilindro de orden bajo IDE

bCylHighReg: BYTE; valor de cilindro de orden alto

bDriveHeadReg: BYTE; // unidad IDE/registro de cabezal

bCommandReg: BYTE; // comando IDE real.

bReserved: BYTE; // reservado para uso futuro. Debe ser cero.

end;

TSendCmdInParams = registro empaquetado

// Tamaño del búfer en bytes

cBufferSize : DWORD;

// Estructura con valores de registro de unidad.

irDriveRegs: TIDERegs;

p> // Número de unidad física a la que enviar el comando (0,1,2,3).

bDriveNumber: BYTE;

bReserved: matriz[0..2] de Byte ;

dwReserved: matriz[0..3] de DWORD;

bBuffer: matriz[0..0] de Byte; // Búfer de entrada.

fin;

TIdSector = registro empaquetado

wGenConfig: Word;

wNumCyls: Word;

wReserved: Word;

wNumHeads: Word;

wBytesPerTrack: Word;

wBytesPerSector: Word;

wSectorsPerTrack: Word;

wVendorUnique: matriz[0..2] de Word;

sSerialNumber: matriz[0..19] de CHAR;

wBufferType: Word;

wBufferSize: Word ;

wECCSize: Word;

sFirmwareRev: matriz[0..7] de Char;

sModelNumber: matriz[0..39] de Char;

wMoreVendorUnique: Word;

wDoubleWordIO: Word;

wCapabilities: Word;

wReserved1: Word;

wPIOTiming: Palabra;

wDMATiming: Palabra;

wBS: Palabra;

wNumCurrentCyls: Palabra;

wNumCurrentHeads: Palabra;

wNumCurrentSectorsPerTrack: Word;

ulCurrentSectorCapacity: DWORD;

wMultSectorStuff: Word;

ulTotalAddressableSectors: DWORD;

wSingleWordDMA: Palabra;

wMultiWordDMA: Palabra;

bReserved: matriz[0..127] de BYTE;

fin;

PIdSector = ^TIdSector;

TDriverStatus = registro empaquetado

// El código de error devuelto por el controlador, si no hay error, devuelve 0

bDriverError : Byte;

//El contenido del registro de errores IDE, solo cuando bDriverError es SMART_IDE_ERROR

Válido

bIDEStatus: Byte;

bReserved: matriz[0..1] de Byte;

dwReserved: matriz[0..1] de DWORD;

end;

TSendCmdOutParams = registro empaquetado

// bTamaño del búfer

cBufferSize: DWORD;

/ / Estado del controlador

DriverStatus: TDriverStatus;

// Búfer utilizado para guardar los datos leídos desde la unidad, la longitud real está determinada por cBufferSize

bBuffer: matriz [0..0] de BYTE;

end;

var

hDevice: Thandle;

cbBytesReturned: DWORD

SCIP: TSendCmdInParams;

aIdOutCmd: matriz[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE - 1) - 1] de Byte;

IdOutCmd: TSendCmdOutParams absoluto aIdOutCmd;

procedimiento ChangeByteOrder(var Data; Tamaño: Entero);

var

ptr: Pchar;

i: Entero;

c: Char;

begin

ptr := @Data;

para I := 0 a (Tamaño shr 1) - 1 comienzo

c := ptr^;

ptr^ := (ptr + 1)^;

(ptr + 1)^ := c;

Inc(ptr, 2);

fin;

fin;

comenzar

Resultado := ''; // Devuelve una cadena vacía si ocurre un error

si SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT entonces comienza // Windows NT, Windows 2000

// ¡Cambiar nombre! Se puede aplicar a otras unidades, como una segunda unidad: '\\.\PhysicalDrive1\'

hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ o GENERIC_WRITE,

FILE_SHARE_READ o FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);

fin else // Versión Windows 95 OSR2, Windows 98

hDispositivo := CreateFile('\\.\ SMARTVSD ', 0, 0, nil, CREATE_NEW, 0, 0);

si hDevice = INVALID_HANDLE_VALUE entonces Salir;<

/p>

intenta

FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);

FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);

cbBytesReturned := 0;

// Configurar estructuras de datos para el comando IDENTIFY.

comience con SCIP

cBufferSize := IDENTIFY_BUFFER_SIZE ;

// bDriveNumber := 0;

con irDriveRegs comienza

bSectorCountReg := 1;

bSectorNumberReg := 1;

// si Win32Platform=VER_PLATFORM_WIN32_NT entonces bDriveHeadReg := $A0

// si no bDriveHeadReg := $A0 o ((bDriveNum and 1) shl 4);

bDriveHeadReg := $A0;

bCommandReg := $EC;

end;

end;

si no DeviceIoControl( hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,

@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) y luego Salir;

finalmente

CloseHandle(hDevice);

fin;

con PIdSector(@IdOutCmd.bBuffer)^ comience

ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber)) ;

(Pchar(@sSerialNumber) + TamañoDe(sSerialNumber))^ := #0;

Resultado := Pchar(@sSerialNumber);

fin ;

fin;

procedimiento TForm1.Button2Click(Remitente: TObject);

comenzar

Edit1.Text := strpas(GetIdeSerialNumber );

end;

end.

{Crea un nuevo proyecto, pega el código, agrega una edición y un

nombre del botón Igual que el interior. Lo he depurado en el entorno xp, pruébalo}