APLICATIVO EM PEM DRIVE
Ola galera...
Tenho um aplicativo am access 2003, que roda com bloqueio por numero de serie do hd, e presciso que ele rode num pem drive, alguem tem ideia de como bloquear a copia desse aplicativo, ou seja pra deixar ele rodar so nesse pen drive, em qualquer pc?
Tenho um aplicativo am access 2003, que roda com bloqueio por numero de serie do hd, e presciso que ele rode num pem drive, alguem tem ideia de como bloquear a copia desse aplicativo, ou seja pra deixar ele rodar so nesse pen drive, em qualquer pc?
o que você pode fazer é pega o id desse pen dirver e so liberar o aplicativo para esse id
como faria isso???
Eu tenho uma função que faz isso.
Em um modulo declare a funcao da API:
[ô]**** Declarações para saber o Numero do HD ********
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
Depois a funcao que retorna o valor:
E por fim obtenha o valor assim:
lblSerial.caption = DriveSerial(C:\)
Att,
Igor
Em um modulo declare a funcao da API:
[ô]**** Declarações para saber o Numero do HD ********
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
Depois a funcao que retorna o valor:
Public Function DriveSerial(ByVal Drive As String) As Long
[ô]Valor que retornará o serial do HD
Dim RetVal As Long
Dim HDNameBuffer As String * 256 [ô]Nome do HD
Dim FSBuffer As String * 256 [ô]FS do HD
Dim a As Long [ô]auxiliar
Dim b As Long [ô]auxiliar
Call GetVolumeInformation(Drive, HDNameBuffer, 256, RetVal, a, b, FSBuffer, 256)
DriveSerial = RetVal
End Function
E por fim obtenha o valor assim:
lblSerial.caption = DriveSerial(C:\)
Att,
Igor
isso fica blz pra hd... de pc onde sua letra de unidade e sempre a mesma mas lembre que pen drive muda de a letra da unidade em computadores diferentes.
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 DriveSerial(ByVal Drive As String) As Long
[ô]Valor que retornará o serial do HD
Dim RetVal As Long
Dim HDNameBuffer As String * 256 [ô]Nome do HD
Dim FSBuffer As String * 256 [ô]FS do HD
Dim a As Long [ô]auxiliar
Dim b As Long [ô]auxiliar
Call GetVolumeInformation(Drive, HDNameBuffer, 256, RetVal, a, b, FSBuffer, 256)
DriveSerial = RetVal
End Function
Private Sub Form_Load()
Me.Caption = DriveSerial(Left(App.Path, 3))
End Sub
da erro em tempo de execução [ô]424 [ô]
objeto obrigatorio
em
Me.Caption = DriveSerial(Left(App.Path, 3))
tentei colocar um label
LblRegistro.Caption = DriveSerial(Left(App.Path, 3))
tb deu o mesmo erro.
objeto obrigatorio
em
Me.Caption = DriveSerial(Left(App.Path, 3))
tentei colocar um label
LblRegistro.Caption = DriveSerial(Left(App.Path, 3))
tb deu o mesmo erro.
so pra avisar o erro é no App.Path
Veja o exemplo em anexo, ele pega o serial de um pendrive.
Obs: não é de minha autoria e numca testei na pratica.
Obs: não é de minha autoria e numca testei na pratica.
isso deve acontecer devido um problema no seu pen driver, ou ele não emite serial de volume disco
Daverson
O exe esta dentro da pen drive???
é só vc pegar a letra da Pen Drive no Path do executavel !!
Igor
O exe esta dentro da pen drive???
é só vc pegar a letra da Pen Drive no Path do executavel !!
Igor
Tópico encerrado , respostas não são mais permitidas