Ver Mensaje Individual
  #3 (permalink)  
Antiguo 09/12/2003, 14:36
Avatar de lic_dahool
lic_dahool
 
Fecha de Ingreso: noviembre-2003
Mensajes: 418
Antigüedad: 20 años, 6 meses
Puntos: 0
pues, una forma es verificando al inicio del programa que el CD este en la unidad y que la información de este corresponda con el CD "original", el código siguiente permite obtener la información del volumen del CD en la unidad:

en un módulo escribir:

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

Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Const DRIVE_CDROM = 5

en el formulario
agregar un boton de comando con el siguiente código:

Private Sub Command1_Click()

Dim VolName As String, FSys As String, erg As Long
Dim VolNumber As Long, MCM As Long, FSF As Long
Dim Drive As String, DriveType As Long

VolName = Space(127)
FSys = Space(127)

Drive = "F:\" 'Escribir la letra de unidad deseada

DriveType& = GetDriveType(Drive$)

erg& = GetVolumeInformation(Drive$, VolName$, 127&, _
VolNumber&, MCM&, FSF&, FSys$, 127&)

Print "VolumeName:" & vbTab & VolName$
Print "VolumeNumber:" & vbTab & VolNumber&
Print "MCM:" & vbTab & vbTab & MCM&
Print "FSF:" & vbTab & vbTab & FSF&
Print "FileSystem:" & vbTab & FSys$
Print "DriveType:" & vbTab & DriveType&;

'si el disco es un CD-ROM ver si esta presente

If DriveType& = DRIVE_CDROM Then
Print " (CDROM, ";

If erg& = 0 Then
Print "no CD in the drive)"
Else
Print "CD in the drive)"
End If

Else

Print " (NO CDROM)"

End If

End Sub


esto aparte de evitar que se use el programa sin el CD es útil para dificultar que se usen copias "ilegales"

saludos.
__________________
La cantidad total de inteligencia del planeta permanece constante.
La población, sin embargo, sigue aumentando.

COLE


:cool: Los ordenadores no resuelven problemas ... ejecutan soluciones.
Laurent Gasser


Tienes alguna duda :pensando: ? >>> www.google.com :aplauso: <<<