[Resolvido]Serial do HD

Bom dia a todos! Amigos estou querendo usar o código abaixo junto com o outro que vi que é do JPaulo. Só que não tá dando certo,alguém pode me ajudar a adaptar, eu tenho que criar uma tabela para capturar o número do HD só que qual seria o nome que tenho que dá a tabela e o nome do campo? O código do JPaulo já serve para não gravar outro número de HD se lá na tabela já tiver outro
Esse código eu uso para pegar o número de série
Option Compare Database
Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Public Function DriveSerialNumber(strDrive As String) As String
'Para obter o numero de serie do HD
'Na janela imediata digite: ?DriveSerialNumber("c")
Dim X As Long, lngSerialNum As Long
Dim strRoot As String
strRoot = Left$(strDrive, 1) & ":\"
X = GetVolumeInformation(strRoot, "", 255, lngSerialNum, 0, 0, "", 255)
DriveSerialNumber = Hex$(lngSerialNum)
End Function
Ai no formulário principal ao abrir coloquei
Call DriveSerialNumber("c")
Feito isso, quando abro o aplicativo ele cria um monte de tabelas, eu queria saber como faria para criar uma tabela e jogar o número do HD nela pq ai depois eu poderia usar o código abaixo do JPaulo para evitar instalar em outro computador


Dim x As String

Dim y As Variant

x=DLookup("SeuCampoNumeroHD","SuaTabela","SeuCampoNumeroHD")

y= Call DriveSerialNumber("c")


If y <> x Then

MsgBox "Não autorizado"

DoCmd.Quit

Else

Exit Sub

End If

Aguardo a ajuda de vocês

Você já tem de ter a tabela criada e o numero de serie inserido nela, para que seja validado assim;


Private Sub Form_Open(Cancel As Integer)
Dim x As String
Dim y As Variant

y = DriveSerialNumber("c")
x = Nz(DLookup("SeuCampoNumeroHD", "SuaTabela", "SeuCampoNumeroHD='" & y & "'"), "")

If y <> x Then

MsgBox "Não autorizado"
DoCmd.Quit

Else

Exit Sub
End If
End Sub

Deu certo aqui Mestre. Uma grande abraço para você e que você continue sempre assim, abençoado por Deus

Executei esse código e ele funcionou perfeitamente no meu notebook Core i5 com Windows 7 de 64 bits, mas não funcionou num servidor com Windows Server 2008 R2 Datacenter de 64 bits, já com Service Pack 1 instalado, equipado com processador AMD Opteron 4171 HE. Pelo jeito, dá pau de cara quando ele vê a instrução chamando o "kernel32", quando surge a mensagem: "Erro de compilação: O código desse projeto deve ser atualizado para uso em sistemas de 64 bits. Analise e atualize instruções Declare e, em seguida, marque-as com o atributo PrtSafe."

Alguém saberia como obter o serial do HD numa máquina de 64 bits?

Obrigado pela atenção.

Olá

veja neste meu artigo abaixo, como usar a condicional #IF para adaptar códigos de 32 e 64 bits. Baixe o arquivo TXT, feito pela Microsoft, com centenas de API's modificadas para atender sitemas de 64 bits

http://www.usandoaccess.com.br/tutoriais/tuto28.asp?id=1#inicio

Bom estudo!

Tente declarar o PtrSafe


Private Declare PtrSafe Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Deveria checkar a versão, antes das instruções com um #If VBA7 Then.

Puxa vida! Vocês são demais!!! Conseguiram resolver o meu pepino em poucos minutos, às 5h da madrugada! E consegui colocar o sistema pra funcionar num Cloud Server antes dos funcionários chegarem pra trabalhar! Valeu demais, galera! O código ficou assim:

Código:

Option Compare Database

#If VBA7 Then
Private Declare PtrSafe Function GetVolumeInformation Lib "kernel32" _
   Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long
#Else
Private Declare Function GetVolumeInformation Lib "kernel32" _
   Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long
#End If

Public Function FuncaoDriveSerialNumber(strDrive As String) As String
   'Para obter o numero de serie do HD
   'Na janela imediata digite: ?FuncaoDriveSerialNumber("c")
   Dim x As Long, lngSerialNum As Long
   Dim strRoot As String
   strRoot = Left$(strDrive, 1) & ":\"
   x = GetVolumeInformation(strRoot, "", 255, lngSerialNum, 0, 0, "", 255)
   FuncaoDriveSerialNumber = Hex$(lngSerialNum)
End Function

Parabéns pela alta qualidade do fórum! Passei a madrugada toda lendo muita coisa interessante aqui e assistindo excelentes vídeos!

Sucesso a todos!

Abraços!

André Basílio.

Obrigado pelo retorno o fórum agradece.

Opa tive o mesmo problema com um comando.
A solução de usar #If VBA7 caiu como uma luva. Ótimo post. Me ajudou muito. Obrigado

Onde que altero esse cod, estou com o mesmo erro! obrigadoo

um exemplo com ajuda de exemplos do forum
https://www.dropbox.com/s/44um9ulk91q0y8o/seral%20e%20nome%20do%20%20hd.rar

só achei um ponto fraco caso o cliente formate o PC o serial do HD muda se alguém tiver uma solução eu agradeço.

Bom dia
Retiraram do site o link do exemplo de como verificar o numero do hd
Voce tem como disponibilizar novamente ??

sou novato aqui, e estou querendo fazer esse tipo de procedimento, estudei esse código , mas não entendi como ele vai comparar o hd, ele é feito em modulo?

Boa Noite a todos!

J.Silas, vc pode disponibilizar novamente o Link do Exemplo por favor, pois o mesmo está inativo. Obrigado.

Download

Ou veja este;

https://www.maximoaccess.com/t118-demo-informar-serial#490

Boa tarde!!!

Muito obrigado JPaulo, abraços, fica com Deus!!!