Serial Number Físico do HD
Função para pegar o serial físico do hd, e não o serial do volume do hd,
pois o serial do volume do hd sempre que o hd é formatado ele muda e também
fazendo uma copia do hd pelo ghost esse número do volume também é copiado.
Então para um controle do programa o ideal é pegar
o serial físico do hd.
{ procedure utilizada pela função que pega o serial do hd }
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;
{ função que pega o serial number FÍSICO do HD e retorna string }
function GetIdeDiskSerialNumber : String;
type
TSrbIoControl = packed record
HeaderLength: ULONG;
Signature: Array[0..7] of Char;
Timeout: ULONG;
ControlCode: ULONG;
ReturnCode: ULONG;
Length: ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;
TIDERegs = packed record
bFeaturesReg : Byte; // especificar "comandos" SMART
bSectorCountReg : Byte; // registro de contador de setor
bSectorNumberReg : Byte; // registro de número de setores
bCylLowReg : Byte; // valor de cilindro (byte mais baixo)
bCylHighReg : Byte; // valor de cilindro (byte mais alto)
bDriveHeadReg : Byte; // registro de drive/cabeça
bCommandReg : Byte; // comando IDE
bReserved : Byte; // reservado- tem que ser zero
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;
TSendCmdInParams = packed record
cBufferSize : DWORD;
irDriveRegs : TIDERegs;
bDriveNumber : Byte;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;
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 : ULONG;
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;
const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IOCTL_SCSI_MINIPORT = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer; // PSendCmdOutParams
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;
begin
Result := '';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
// Windows NT, Windows 2000, Windows XP
begin
// recuperar handle da porta SCSI
hDevice := CreateFile('\\.\Scsi0:',
// Nota: '\\.\C:' precisa de privilégios administrativos
GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer)
+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, @Buffer,
BufferSize, @Buffer, BufferSize, cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin
// Windows 95 OSR2, Windows 98, Windows ME
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0
);
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := @pInData^.bBuffer;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
pInData, SizeOf(TSendCmdInParams)-1, pOutData, W9xBufferSize, cbBytesReturned,
nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end;
Para usar:
Label1.Caption := GetIdeDiskSerialNumber;
Não sei porque mas a função retorna a string com 12 espaços antes do
serial, então usei a função Trim(), para eliminar os espaços
Label1.Caption := Trim(GetIdeDiskSerialNumber);
Obs. No windows95, windows98 e windowsMe, deve-se instalar o arquivo
"Smartvsd.vxd" na pasta "c:windows\system\iosubsys\" para poder funcionar.
Achei esta ve se serve para você eu nunca testei ela mas se funcionar certinho
me fale ok...
Adriano
Micro center
----- Original Message -----
From: Adriano (Micro Center)
To: delphi-br@yahoogrupos.com.br
Sent: Saturday, July 02, 2005 2:18 PM
Subject: Re: RES: RES: [delphi-br] serial do hd
OK, Agora eu entendi vc quer o munero Fisico do hd ,,,não o de serie , cara
eu tinha uma função dessa aqui, mas não sei se vou conseguir encontar ela ..
Lembro que ela me dava serie do DH , data de fabricação, Numero Logico...Tudo
do hd ela me mostrava.....
caso eu encontar eu te envio...
Adriano
Micro Center
----- Original Message -----
From: Vinicius Ribeiro
To: delphi-br@yahoogrupos.com.br
Sent: Saturday, July 02, 2005 2:08 PM
Subject: Re: RES: RES: [delphi-br] serial do hd
Nao.. eh IDE mesmo. Tipo, a funcao abaixo pega o numero de serie LOGICO,
mas nao o FISICO. Ai se o cara clonar o numero LOGICO pra outro HD entao
o sistema funcionarah numa boa. O lance eh pegar numero fisico, porem
teve HD q eu testei (HD IDE) q nao funcionou.
[ ]'s
Vinicius Ribeiro
Adriano (Micro Center) escreveu:
> Tambem tem uma coisa , sera possivel este hd nao esta informando o seu
> numero serial por ser um hd SATA...
> Pois eu acho que a tecnologia SATA é diferente dos IDE.....
> ----- Original Message -----
> From: Vinicius Ribeiro
> To: delphi-br@yahoogrupos.com.br
> Sent: Saturday, July 02, 2005 10:32 AM
> Subject: Re: RES: RES: [delphi-br] serial do hd
>
>
> Adriano,
>
> Seria o numero de série FISICO do HD. Essa funcao pega o numer de serie
> LOGICO, correto?
>
> [ ]'s
>
> Vinicius Ribeiro
>
> Adriano (Micro Center) escreveu:
>
> > Detectando o Numero Serial do HD
> > Function SerialNum(FDrive:String) :String;
> > Var
> > Serial:DWord;
> > DirLen,Flags: DWord;
> > DLabel : Array[0..11] of Char;
> > begin
> > Try
> >
>
GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
> > Result := IntToHex(Serial,8);
> > Except Result :='';
> > end;
> > end;
> >
> > Adriano
> > Micro Center..........
> > ----- Original Message -----
> > From: Vinicius Ribeiro
> > To: delphi-br@yahoogrupos.com.br
> > Sent: Saturday, July 02, 2005 9:35 AM
> > Subject: Re: RES: RES: [delphi-br] serial do hd
> >
> >
> > Wilson,
> >
> > Eu tenho essa funcao mas la onde trabalho. To em casa agora e soh
> > trabalho na segunda. Porem, fiz testes com essa funcao em 20
> > maquinas la
> > da empresa. Essa funcao funciona bem porem teve alguns HDs que
> retornou
> > VAZIO. Ai vi la no HD se tinha numero de serie impresso no rotulo e
> > tinha. Ou seja a funcao nao retorna de todos, nao me pergunte o
> porque.
> >
> > Se alguem aqui quiser posso disponibiliza-la pra lista, mas soh na
> > segunda. Inclusive eu peguei de alguem q mandou pra lista aqui
> mesmo.
> >
> > Stock, vc testou essa funcao em varios micros com marcas de HD
> > diferente? Retornou em todas? Se sim poderia disponibiliza-la
> para a
> > lista?
> >
> > Abraco!
> >
> > Vinicius Ribeiro
> >
> > Wilson Valdevite escreveu:
> >
> > > Desculpe a minha curiosidade pois isso tbem me interessa, mas por
> > que não
> > > mandar para a lista?
> > >
> > > Wilson
> > > ----- Original Message -----
> > > From: "Stock" <[EMAIL PROTECTED]>
> > > To: <delphi-br@yahoogrupos.com.br>
> > > Sent: Friday, July 01, 2005 5:15 PM
> > > Subject: Res: Re: RES: RES: [delphi-br] serial do hd
> > >
> > >
> > > Esta função pega o serial do volume, se o volume for clonado, sua
> > > aplicação vai rodar em outro normalmente...
> > >
> > > use a que pega o serial fisico do disco...
> > >
> > > me contate em pvt, eu te mando a função com exemplo
> > >
> > >
> > > [EMAIL PROTECTED]
> > > 600 modelos de sites profissionais - Imperdivel
> > > http://www.kitsites.com/index.php?ref=50
> > >
> > > -------Mensagem original-------
> > >
> > > De: Leandro
> > > Data: 07/01/05 16:55:18
> > > Para: delphi-br@yahoogrupos.com.br
> > > Assunto: Re: RES: RES: [delphi-br] serial do hd
> > >
> > > uso essa danada:
> > >
> > > function TCritica.PegaSerieHD: String;
> > > var
> > > SerialNum : Dword;
> > > a, b : dword;
> > > Buffer : array [0..255] of char;
> > > begin
> > > if
> > >
> GetVolumeInformation('c:\',buffer,sizeof(buffer),@serialnum,a,b,nil,0)
> > > then
> > > Result := inttohex(serialnum,8)
> > > else
> > > Result := '';
> > > end;
> > >
> > > Att,
> > >
> > > Leandro
> > >
> > > ----- Original Message -----
> > > From: "aderson rezende" <[EMAIL PROTECTED]>
> > > To: <delphi-br@yahoogrupos.com.br>
> > > Sent: Friday, July 01, 2005 4:30 PM
> > > Subject: Re: RES: RES: [delphi-br] serial do hd
> > >
> > >
> > > obrigado
> > >
> > > continuo precisando da dica de como fazer isso como pegar tal
> numero
> > >
> > >
> > >
> > > Walter Alves Chagas Junior <[EMAIL PROTECTED]> escreveu:
> > > Então não pegue o serial do voluma do HD, pegue o serial da
> > controladora
> > >
> > >
> > >
> > >
> > > []s
> > >
> > > Walter Alves Chagas Junior
> > > Projeto e desenvolvimento
> > > Telemont Engenharia de telecomunicações
> > > Belo Horizonte - MG - Brazil
> > > [EMAIL PROTECTED]
> > > Fone: (31) 3389-8215 Fax: (31) 3389-8200
> > >
> > >
> > > > -----Mensagem original-----
> > > > De: aderson rezende [mailto:[EMAIL PROTECTED]
> > > > Enviada em: sexta-feira, 1 de julho de 2005 15:01
> > > > Para: delphi-br@yahoogrupos.com.br
> > > > Assunto: Re: RES: [delphi-br] serial do hd
> > > >
> > > >
> > > > quase isso Walter a ideia é colocar um tempo de validade
> > > > para locação da aplicação e um dos parametros pensei no
> serial do HD
> > > >
> > > >
> > > >
> > > >
> > > >
> > > > Walter Alves Chagas Junior <[EMAIL PROTECTED]> escreveu:
> > > > Desculpe intrometer no assunto amigo, mas você tá querendo
> fazer
> > algum
> > > > mecanismo de proteção contra cópia não autorizada?
> > > >
> > > >
> > > >
> > > > []s
> > > >
> > > > Walter Alves Chagas Junior
> > > > Projeto e desenvolvimento
> > > > Telemont Engenharia de telecomunicações
> > > > Belo Horizonte - MG - Brazil
> > > > [EMAIL PROTECTED]
> > > > Fone: (31) 3389-8215 Fax: (31) 3389-8200
> > > >
> > > >
> > > > > -----Mensagem original-----
> > > > > De: aderson rezende [mailto:[EMAIL PROTECTED]
> > > > > Enviada em: sexta-feira, 1 de julho de 2005 10:23
> > > > > Para: delphi-br@yahoogrupos.com.br
> > > > > Assunto: [delphi-br] serial do hd
> > > > >
> > > > >
> > > > > preciso pegar o serial do HD
> > > > > usei essa função e cada hora vem um valor diferente ou
> > > > > melhor sempre da dois valores 1 por vez
> > > > >
> > > > >
> > > > > Function SerialNum(FDrive:String)
> > > > > :String;VarSerial:DWord;DirLen,Flags: DWord;DLabel :
> > > > > Array[0..11] of Char;beginTry
> > > > > GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirL
> > > > > en,Flags,nil,0);Result := IntToHex(Serial,8); Except Result
> > > > > :='';end;end; como faço para retornar o resultado dessa
> > > > > função???pode ser esse o erro
> > > > >
> > > > >
> > > > >
> > > > >
> > > > >
_______________________________________________________
Yahoo! Acesso Grátis - Internet rápida e grátis.
Instale o discador agora! http://br.acesso.yahoo.com/
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
------------------------------------------------------------------------------
Links do Yahoo! Grupos
a.. Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
b.. Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
c.. O uso que você faz do Yahoo! Grupos está sujeito aos Termos do
Serviço do Yahoo!.
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
------------------------------------------------------------------------------
Links do Yahoo! Grupos
a.. Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
b.. Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
c.. O uso que você faz do Yahoo! Grupos está sujeito aos Termos do Serviço
do Yahoo!.
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
