Copie el código de código de la siguiente manera:
//Referencia y declaración de variable TIPO
usos
Windows, Mensajes, SysUtils, Variantes, Clases, Gráficos, Controles, Formularios,
Diálogos, StdCtrls, nb30;
tipo
PASTATO = ^TASTATO;
TASTAT=registro
adaptador: TAdapterStatus;
nombre_buf: TNameBuffer;
fin;
TForm1 = clase(TForm)
Botón1: TBotón;
Edición1: TEditar;
Etiqueta1: TLabel;
Etiqueta2: TLabel;
Etiqueta3: TLabel;
Edición2: TEditar;
Editar3: TEditar;
Botón2: TBotón;
Editar4: TEditar;
Etiqueta4: TLabel;
procedimiento Button1Click(Remitente: TObject);
procedimiento Button2Click(Remitente: TObject);
privado
{Declaraciones privadas}
público
{Declaraciones públicas}
fin;
var
Formulario1: TForm1;
implementación
{$R *.dfm}
tipo
TCPUID = matriz[1..4] de Entero largo;
//Obtener el número de serie del disco duro:
función GetIdeSerialNumber: pchar //Obtiene el número de serie de fábrica del disco duro;
constante IDENTIFY_BUFFER_SIZE = 512;
tipo
TIDERegs = registro empaquetado
bCaracterísticasReg: BYTE;
bSectorCountReg: BYTE;
bSectorNumberReg: BYTE;
bCylLowReg: BYTE;
bCylHighReg: BYTE;
bDriveHeadReg: BYTE;
bCommandReg: BYTE;
bReservado: BYTE;
fin;
TSendCmdInParams = registro empaquetado
cBufferTamaño: DWORD;
irDriveRegs: TIDERegs;
bNúmero de unidad: BYTE;
bReservado: matriz[0..2] de Byte;
dwReserved: matriz[0..3] de DWORD;
bBuffer: matriz[0..0] de Byte;
fin;
TIdSector = registro empaquetado
wGenConfig: Palabra;
wNumCyls: Palabra;
wReservado: Palabra;
wNumHeads: Palabra;
wBytesPerTrack: Palabra;
wBytesPerSector: Palabra;
wSectoresPorPista: Palabra;
wVendorUnique: matriz[0..2] de Word;
sSerialNumber: matriz [0..19] de CHAR;
wBufferType: Palabra;
wBufferSize: Palabra;
wECCTamaño: Palabra;
sFirmwareRev: matriz[0..7] de Char;
sModelNumber: matriz[0..39] de Char;
wMoreVendorUnique: Palabra;
wDoubleWordIO: Palabra;
wCapacidades: Word;
wReservado1: Palabra;
wPIOTincronización: Palabra;
wDMAtiming: Palabra;
wBS: Palabra;
wNumCurrentCyls: Palabra;
wNumCurrentHeads: Palabra;
wNumCurrentSectorsPerTrack: Palabra;
ulCurrentSectorCapacity: DWORD;
wMultSectorStuff: Palabra;
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: Palabra;
wMultiWordDMA: Palabra;
bReservado: matriz[0..127] de BYTE;
fin;
PIdSector = ^TIdSector;
TDriverStatus = registro empaquetado
bDriverError: Byte;
bIDEEstado: Byte;
bReservado: matriz[0..1] de Byte;
dwReserved: matriz[0..1] de DWORD;
fin;
TSendCmdOutParams = registro empaquetado
cBufferTamaño: DWORD;
Estado del conductor: TDriverStatus;
bBuffer: matriz[0..0] de BYTE;
fin;
var
hDispositivo: Thandle;
cbBytes devueltos: DWORD;
SCIP:TSendCmdInParams;
aIdOutCmd: matriz[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] de byte;
IdOutCmd: TSendCmdOutParams aIdOutCmd absoluto;
procedimiento ChangeByteOrder(var Data; Size: Integer);//El proceso en la función
var
ptr: Pchar;
i: Entero;
c: carbón;
comenzar
ptr := @Datos;
para I: = 0 a (Tamaño shr 1) - 1 comienza
c := ptr^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := c;
Inc(ptr, 2);
fin;
fin;
comenzar // cuerpo de la función
Resultado := '';
si SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT entonces
comenzar // Windows NT, Windows 2000
hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ o GENERIC_WRITE,
FILE_SHARE_READ o FILE_SHARE_WRITE, nulo, OPEN_EXISTING, 0, 0);
fin
más // Versión Windows 95 OSR2, Windows 98
hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, Create_NEW, 0, 0);
si hDevice = INVALID_HANDLE_VALUE entonces Salir;
intentar
FillChar(SCIP, TamañoDe(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, TamañoDe(aIdOutCmd), #0);
cbBytes devueltos: = 0;
con SCIP hacer
comenzar
cBufferSize := IDENTIFY_BUFFER_SIZE;
con irDriveRegs hacer
comenzar
bSectorCountReg := 1;
bRegNúmeroSector := 1;
bDriveHeadReg := $A0;
bRegComando := $EC;
fin;
fin;
si no es DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) entonces salga;
finalmente
CloseHandle(hDispositivo);
fin;
con PIdSector(@IdOutCmd.bBuffer)^ hacer
comenzar
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + TamañoDe(sSerialNumber))^:= #0;
Resultado := Pchar(@sSerialNumber);
fin;
fin;
//================================================== ==================
//Número de serie de la CPU:
FUNCIÓN GetCPUID: TCPUID; registro del ensamblador;
ENSAMBLE
PUSH EBX {Guardar registro afectado}
EMPUJAR EDI
MOVEDI,EAX {@Resukt}
MOV EAX,1
DW $A20F {Comando CPUID}
ESTADO {CPUID[1]}
MOVIMIENTO EAX,EBX
STOSD {CPUID[2]}
MOV EAX, ECX
STOSD {CPUID[3]}
MOV EAX, EDX
STOSD {CPUID[4]}
POP EDI {Restaurar registros}
POPEBX
FIN;
función GetCPUIDStr:Cadena;
var
ID de CPU: TCPID;
comenzar
CPUID:=ObtenerCPUID;
Resultado:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
fin;
///================================================ = =====================================
/// Obtener MAC (tarjeta de red no integrada):
función NBGetAdapterAddress (a: entero): cadena;
var
NCB: TNCB; // bloque de control Netbios // bloque de control NetBios
ADAPTADOR: TADAPTERSTATUS; // Estado del adaptador Netbios // Obtener el estado de la tarjeta de red
LANAENUM: TLANAENUM // Netbios lana
intIdx: Entero; // Valor de trabajo temporal//Variable temporal
cRC: Char; // código de retorno de Netbios // valor de retorno de NetBios
strTemp: cadena; // Cadena temporal//Variable temporal
comenzar
//Inicializar
Resultado := '';
intentar
// bloque de control cero
MemoriaCero(@NCB, TamañoDe(NCB));
// Emitir comando enumeración
NCB.ncb_command := Chr(NCBENUM);
cRC := NetBios(@NCB);
// Reemitir el comando enum
BCN.ncb_buffer := @LANAENUM;
NCB.ncb_length := TamañoDe(LANAENUM);
cRC := NetBios(@NCB);
si ord(cRC) <> 0 entonces
salida;
//Reiniciar adaptador
MemoriaCero(@NCB, TamañoDe(NCB));
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana[a];
cRC := NetBios(@NCB);
si ord(cRC) <> 0 entonces
salida;
// Obtener la dirección del adaptador
MemoriaCero(@NCB, TamañoDe(NCB));
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana[a];
StrPCopy(NCB.ncb_callname, '*');
BCN.ncb_buffer := @ADAPTER;
NCB.ncb_length := TamañoDe(ADAPTADOR);
cRC := NetBios(@NCB);
//Conviértelo en cadena
strTemp := '';
para intIdx: = 0 a 5 hacer
strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
Resultado := strTemp;
finalmente
fin;
fin;
//================================================== ============================
//Obtener la dirección MAC (tarjeta de red integrada y tarjeta de red no integrada):
función Getmac:cadena;
var
ncb: TNCB;
s:cadena;
adaptar: GUSTO;
lanaEnum: TLanaEnum;
i, j, m: número entero;
strPart, strMac: cadena;
comenzar
FillChar(ncb, TamañoDe(TNCB), 0);
ncb.ncb_command := Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length := TamañoDe(TLanaEnum);
s:=Netbios(@ncb);
para i: = 0 a entero (lanaEnum.length) -1 hacer
comenzar
FillChar(ncb, TamañoDe(TNCB), 0);
ncb.ncb_command := Char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana[i];
Netbios(@ncb);
Netbios(@ncb);
FillChar(ncb, TamañoDe(TNCB), 0);
ncb.ncb_command := Chr(NCBAstat);
ncb.ncb_lana_num := lanaEnum.lana[i];
ncb.ncb_callname := '* ';
ncb.ncb_buffer := PChar(@adapt);
ncb.ncb_length := TamañoDe(TASTAT);
metro:=0;
si (Win32Platform = VER_PLATFORM_WIN32_NT) entonces
metro:=1;
si m=1 entonces
comenzar
si Netbios(@ncb) = Chr(0) entonces
strMac := '';
para j := 0 a 5 hacer
comenzar
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
fin;
EstablecerLongitud(strMac, Longitud(strMac)-1);
fin;
si m=0 entonces
si Netbios(@ncb) <> Chr(0) entonces
comenzar
strMac := '';
para j := 0 a 5 hacer
comenzar
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
fin;
EstablecerLongitud(strMac, Longitud(strMac)-1);
fin;
fin;
resultado:=strmac;
fin;
función PartitionString(StrV,PrtSymbol: cadena): TStringList;
var
iTemp: entero;
comenzar
resultado := TStringList.Create;
iTemp := pos(PrtSymbol,StrV);
mientras iTemp>0 comienza
si iTemp>1 entonces result.Append(copy(StrV,1,iTemp-1));
eliminar(StrV,1,iTemp+length(PrtSymbol)-1);
iTemp := pos(PrtSymbol,StrV);
fin;
si Strv<>'' entonces result.Append(StrV);
fin;
función MacStr():Cadena;
var
Str:TStrings;
i:Entero;
MacStr:Cadena;
comenzar
MacStr:='';
Str:=TStringList.Create;
Str:=PartitionString(Getmac,'-');
para i:=0 a Str.Count-1 hacer
MacStr:=MacStr+Str[i];
Resultado:=MacStr;
fin;
//================================================
//Ejemplo de llamada
procedimiento TForm1.Button1Click (Remitente: TObject);
comenzar
Edit3.Text:=strpas(GetIdeSerialNumber);//Obtener el número del disco duro
Edit2.text:=GetCPUIDStr;//Número de serie de la CPU
edit4.Text:=NBGetAdapterAddress(12);//Tarjeta de red no integrada
Edit1.text:=MacStr;//Tarjetas de red integradas y no integradas
fin;