Newsgroup: it.comp.appl.access
Titolo: Protezione con numero seriale

Ho più volte provato ad aprire il file serialHD.mdb scaricato dal sito del
newsgroup per vedere come è stata implementata la protezione attraverso il
numero seriale dell'HD ma tutte le volte mi dice "L'account utente corrente
non dispone delle autorizzazioni per convertire o abilitare il database" e
mi chiude il file. Sbaglio qualcosa io o il file è solo un dimostrazione che
con quella protezione non è possibile entrare (leggi: allora a cosa mi
serve? :-)))
Grazie.
Danilo.





 ha scritto nel messaggio
news:Yjur9.41859$RO.10...@twister1.libero.it...

Se però non ricordo male, se digiti la parola chiave che lui ti suggerisce,
il database si chiude ugualmente, ma quando lo riapri le volte successive
non ti chiede più la parola chiave e ti lascia operare con il database.
O sbaglio?
--
Roberto
---------------------------------------------
il Sito Comune di it.comp.appl.access:
http://www.sitocomune.com
---------------------------------------------


A me non chiede una parola chiave, quando lo lancio mi presenta subito il
messaggio di non autorizzazione e non procede;
a dire il vero non ho visto riportata alcuna parola chiave; ho notato che il
file è fatto con Access 97 ed io uso Access 2000, può essere questo il
motivo?
Danilo.

Non so se ho capito bene ma se state parlando di memorizzare il numero
seriale dell'hard disk in un tabella access per farne
uso a livello di sicurezza (esempio : se  il programma viene copiato su un
altro pc non deve funzionare) allora credo di potervi dare
umilmente una mano.
Io ho realizzato il tutto e non è molto difficile.
Vi posto il codice qui di seguito che dovrà essere messo nella maschera che
effettua il controllo:
***************************************************************************
Option Compare Database
'***
Option Explicit
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
Private Sub rgbGetVolume(PathName As String, _
                         DrvVolumeName As String, _
                         DrvSerialNo As String)
  'create working variables
  'to keep it simple, use dummy variables for info
  'we're not interested in right now
   Dim r As Long
   Dim pos As Integer
   Dim hword As Long
   Dim HiHexStr As String
   Dim lword As Long
   Dim LoHexStr As String
   Dim VolumeSN As Long
   Dim MaxFNLen As Long
   Dim UnusedStr As String
   Dim UnusedVal1 As Long
   Dim UnusedVal2 As Long
  'pad the strings
   DrvVolumeName = Space$(14)
   UnusedStr = Space$(32)
  'do what it says
   r = GetVolumeInformation(PathName, _
                            DrvVolumeName, _
                            Len(DrvVolumeName), _
                            VolumeSN&, _
                            UnusedVal1, UnusedVal2, _
                            UnusedStr, Len(UnusedStr))
  'error check
   If r = 0 Then Exit Sub
  'determine the volume label
   pos = InStr(DrvVolumeName, Chr$(0))
   If pos Then DrvVolumeName = Left$(DrvVolumeName, pos - 1)
   If Len(Trim$(DrvVolumeName)) = 0 Then DrvVolumeName = "(no label)"
  'determine the drive volume id
   hword = HiWord(VolumeSN)
   lword = LoWord(VolumeSN)
   HiHexStr = Format$(Hex(hword), "0000")
   LoHexStr = Format$(Hex(lword), "0000")
   DrvSerialNo = HiHexStr & "-" & LoHexStr
End Sub
Private Function HiWord(dw As Long) As Integer
    HiWord = (dw And &HFFFF0000) \ &H10000
End Function
Private Function LoWord(dw As Long) As Integer
    If dw And &H8000& Then
        LoWord = dw Or &HFFFF0000
    Else
        LoWord = dw And &HFFFF&
    End If
End Function
'--end block--
****************************************************************************
***********
successivamente potete controllare tutto tramite una funzione di questo tipo
:
Private Sub nomesub
Dim PathName As String
Dim DrvVolumeName As String
Dim DrvSerialNo As String
PathName$ = "c:\"
rgbGetVolume PathName, DrvVolumeName, DrvSerialNo
Me![nomevolume] = DrvVolumeName
Me![serialvolume] = DrvSerialNo
Me![esci].Visible = True
Me![esci].Enabled = True
End Sub
****************************************************************************
*******************

 Danilo.


 ha scritto nel messaggio
news:B9Hr9.45381$RO.11...@twister1.libero.it...

Grazie, il codice funziona e rileva etichetta del volume e numero seriale.
Una volta rilevato il numero dove conviene memorizzarlo per creare una
protezione sull'apertura successiva:
1) una tabella ?
2) un file esterno ?
3) ... ?
Grazie.

 ha scritto nel messaggio
news:c_Rr9.46664$RO.11...@twister1.libero.it...

Proverò su un PC con Access 97 perchè con Access 2K non mi propone nemmeno
di convertirlo o aprirlo come versione precedente!


Prego, sono contento che funziona.
Io  ho semplicemente creato una procedura che alla prima apertura del db va
a controllare in una tabella del db se esiste un determinato valore.
Supponi di avere la tabella accettalicenza.
in questa tabella hai i seguenti campi (li separo con ; per comodità di
lettura qui nel NG)
id; AccettoLicenza ;data; nomevolume ;serialvolume; datainst ;datascad
che possono contenere i seguenti dati:
13 ;1; 18/10/2002 ;1.27.23; (no label) ;10000000000-196E ;18/10/2002;
17/11/2002;
Fai uan procedura che ti chieda solo la prima volta che viene aperto il db
se accetti la licenza d'uso o meno.
All'atto dell'accettazione (esempio : su evento click del pulsante " si
accetto" ) fai inserire tramite codice VB
un valore nel campo accettolicenza. (1 = accettato ; 2 = non accettato)
Successivamente all'accettazione fai inserire da VB gli altri parametri (es.
data prima istallazione,data scadenza del programma, nomevolume,
serialvolume)
se ti occorrono.
Alla prossima apertura esegui un controllo sul contenuto della tabella
accettolicenza dove verifichi il valore di accettolicenza (es. se è 2 allora
chiudi il db)
Ti posso postare dei esempi ma poi devi vedere tu cosa ne vuoi fare di
questo sistema.
*********************************
If DLookup("[serialvolume]", "accettolicenza", Value) <> DrvSerialNo Then
MsgBox "Dati del programma corrotti." & Chr(13) & "Questa è una copia
illegale !", vbInformation, "Copia non autorizzata !"
If DLookup("[serialvolume]", "accettolicenza", Value) <> DrvSerialNo Then
DoCmd.Close acForm, "Pannello comandi"
DoCmd.RunMacro "autoexec", 0
If DLookup("[serialvolume]", "accettolicenza", Value) <> DrvSerialNo Then
DoCmd.DeleteObject acForm, "Pannello comandi"
If DLookup("[serialvolume]", "accettolicenza", Value) <> DrvSerialNo Then
Application.Quit   ' inserire qui per cancellare il db
If DLookup("[nomevolume]", "accettolicenza", Value) <> DrvVolumeName Then
MsgBox "Dati del programma corrotti." & Chr(13) & "Contattare il fornitore
!", vbExclamation, "Corruzzione dati !"
If DLookup("[nomevolume]", "accettolicenza", Value) <> DrvVolumeName Then
DoCmd.Close acForm, "Pannello comandi"
DoCmd.RunMacro "autoexec", 0
If DLookup("[nomevolume]", "accettolicenza", Value) <> DrvVolumeName Then
DoCmd.DeleteObject acForm, "Pannello comandi"
If DLookup("[nomevolume]", "accettolicenza", Value) <> DrvVolumeName Then
Application.Quit   ' fase di chiusura programma
'*** fine fase di copyprotection
If DLookup("[accettolicenza]", "accettolicenza", Value) = 1 Then GoTo fine
Else
If DLookup("[accettolicenza]", "accettolicenza", Value) = 2 Then GoTo
Nolicenza Else  ' altrimenti se diverso da 1 o 2
GoTo AccettareLicenza
Nolicenza:
   MsgBox "Spiacente , ma non avete accettato la licenza d'uso." & Chr(13) &
"Rivolgersi al fornitore ! ", vbExclamation, "Licenza non accettata !!"
   If DLookup("[accettolicenza]", "accettolicenza", Value) = 2 Then
Application.Quit
AccettareLicenza:
   MsgBox "Licenza non valida." & Chr(13) & "Accettare la licenza d'uso per
usare il programma.", vbCritical, "Avviso di Protezione Licenza"
   DoCmd.OpenForm "AccettoLicenza"
   GoTo tuttook
fine:
'*****  controllo scadenza programma
datainstallazione = (DLookup("[datainst]", "accettolicenza", Value))
DataScadenza = (DLookup("[datascad]", "accettolicenza", Value))
If Now >= datainstallazione Then GoTo controllo1 Else GoTo problema 'MsgBox
"tutto ok perchè " & Now & " è maggiore o uguale a " & datainstallazione
controllo1:
If Now >= DataScadenza Then GoTo problema Else GoTo tuttook
problema:
MsgBox "Tempo di valutazione terminato o errore di data ! Reinstallare il
prodotto."
'inserire il codice per cancellare la form iniziale del db
DoCmd.Close acForm, "pannello comandi"
'DoCmd.DeleteObject acForm, "Pannello comandi"
Application.Quit
tuttook:
If DLookup("[accettolicenza]", "accettolicenza", Value) = 1 Then DoCmd.Beep
'MsgBox "Controllo licenza OK !"
DoCmd.Beep
End Sub
***********************************************
Spero ti sia tutto molto utile
Questa è pura PAPPA PRONTA !!!!!
Ciao e buon lavoro

 ha scritto nel messaggio
news:B3Vr9.47179$%M1.11...@twister2.libero.it...

Mi piace, la provo questa sera, intanto ancora grazie.
PS: sai nulla sul protocollo per le comunicazioni criptate in internet
"https" o dove poter trovare materiale?
Danilo.

 Mi piace, la provo questa sera, intanto ancora grazie.
Ma perché quotare 137 righe per dire grazie?


Non so se hai capito il messaggio di Claudio ma te lo riassumo brevemente :
Non serve ripetere il testo inviato come spiegazione nel tuo nuovo messaggio
almeno che sia utile per capire cio' che dici nel messaggio stesso.
Nel senso : tutte le istruzioni che ho scritto le puo' vedere chiunque nei
messaggi precedenti , quindi per facilitare la lettura delle risposte č
inutile
ripetere il testo della risposta prcedente "almeno che serva proprio", ma
nel nostro caso non occoreva.
Insomma conviene sempre tagliare i messaggi nel ri-postare lasciando solo
gli elementi principali che permettono a chi ha letto il messaggio prima di
capire quello successivo.
Per quanto riguarda https non so nulla, purtroppo non so aiutarti.
Prova a vedere magari sul sito 
www.html.it
  cercando la parola https oppure
comunicazioni criptate !!!
Ciao e buon divertimento.
Con simpatia.
Marco