Seguridad Anticopias en VB6 "El Proyecto" por (Geovanny Avila)

[Frehley]

Bueno, les muestro lo que hice yo:

Esto va cuando ejecuta el programa:

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)
Dim cad1 As String * 256
Dim cad2 As String * 256
Dim numSerie As Long
Dim longitud As Long
Dim flag As Long

Private Sub Command1_Click()
If (Val(Reg1.Text) = (numSerie + 1500)) And (Val(Reg2.Text) = (numSerie + 1600)) And (Val(Reg3.Text) = (numSerie + 1900)) Then
MsgBox "El programa ha sido registrado", vbInformation, ""
SaveSetting App.Title, Me.Name, Me.Reg1.Name, Me.Reg1.Text
SaveSetting App.Title, Me.Name, Me.Reg2.Name, Me.Reg2.Text
SaveSetting App.Title, Me.Name, Me.Reg3.Name, Me.Reg3.Text
Form1.Show
Unload Me
Else
MsgBox "El numero introducido es incorrecto", vbCritical, ""
End If
End Sub

Private Sub Form_Initialize()
If (Val(Reg1.Text) = (numSerie + 1500)) And (Val(Reg2.Text) = (numSerie + 1600)) And (Val(Reg3.Text) = (numSerie + 1900)) Then
Form1.Show
Unload Me
End If
End Sub

Private Sub Form_Load()

unidad = "C:\"
Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256)
Text1.Text = numSerie
Reg1.Text = GetSetting(App.Title, Me.Name, Reg1.Name, vbChecked)
Reg2.Text = GetSetting(App.Title, Me.Name, Reg2.Name, vbChecked)
Reg3.Text = GetSetting(App.Title, Me.Name, Reg3.Name, vbChecked)
Text1.Text = numSerie

End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.Title, Me.Name, Me.Reg1.Name, Me.Reg1.Text
SaveSetting App.Title, Me.Name, Me.Reg2.Name, Me.Reg2.Text
SaveSetting App.Title, Me.Name, Me.Reg3.Name, Me.Reg3.Text
End Sub

Y este es el generador de serials:

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)
Dim cad1 As String * 256
Dim cad2 As String * 256
Dim numSerie As Long
Dim longitud As Long
Dim flag As Long
Private Sub cmdGenerar_Click()

unidad = "C:\"

Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256)
numSerie = primera.Text
registro1.Text = (numSerie + 1500)
registro2.Text = (numSerie + 1600)
registro3.Text = (numSerie + 1900)
End Sub

Private Sub cmdSalir_Click()
If MsgBox("¿Está usted seguro que desea Salir de SerialZax?", _
vbQuestion + vbYesNo, "Pregunta") = vbYes Then
End
End If
End Sub

Private Sub Form_Load()

unidad = "C:\"
Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256)

primera.Text = numSerie
End Sub

Qué les parece? Hasta ahora me funciona perfecto. Seguramente hay errores o variables de más, pero lo hice apurado.

Salu2!