Newsgroup: it.comp.lang.visual-basic
Titolo: Protezione del codice in Vb - Help

Ciao a tutti,
ho il seguente problema: il capo mi ha ordinato di trovare il modo di
proteggere il codice di un'applicazione in vb: spiegandomi meglio,
dovrei inibire l'utilizzo dell'applicazione agli utenti non registrati
(insomma, che non se la sono comprata), magari dopo un certo periodo di
tempo di prova: qualcuno sa dirmi dove posso trovare info al riguardo?
Grazie
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 dovrei inibire l'utilizzo dell'applicazione agli utenti non registrati
.............
Che ne diresti di un sistema che usa delle chiavi e legge direttamente il
serial dell'HD ??? Cosi' funziona solo sulla macchina in cui lo
installa...; in pratica il serial dell'hd viene codificato tramite un
algoritmo e poi, per decodificarlo occore inserire una seconda key che,
decodificata, e' uguale alla prima che viene letta.....mmmm.....non so se
sono stato chiaro, in ogni caso se interessa posto il codice...anche se
e' un po' lunghetto..... 

 
Ciao, grazie!
posta, posta che mi interessa
buona giornata
Massimo


 posta, posta che mi interessa
---Nel modulo:-----
Option Explicit
Public Const GETDI_SERIAL = 1
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 
Function controllakey()
    Dim ser As String, reg As String, pass As String
    ser = GetDriveInfo("C:\", GETDI_SERIAL)
    reg = GetSetting("nomekeyregistro", "startup", "val", 100)
    If (Val(reg) = 100) Then 'se non esiste
        form1.Visible = False
        Load key 'form con per inserimento key di attivazione
        key.Show
    Else 'se non corrispondono i serial dell'HD
        pass = serial("D", "passdidecriptazione", reg)
        If pass <> ser Then
            On Error Resume Next
            DeleteSetting "nomekyeregistro", "startup"
            form1.Visible = False
            Load key
            key.Show
        End If
    End If
End Function
Function chiave()
        Dim valreg As Variant, cod As String, cod2 As String
        valreg = GetSetting("nome key registro", "startup", "val", 100)
        cod = serial("D", "passdidecript", key.cod2.Text)
        cod2 = serial("E", "passdiencript", cod)
        SaveSetting "nomekey del registro", "Startup", "val", cod2
End Function
Public Function GetDriveInfo(strDrive As String, iType As Integer)
    Dim SerialNum As Long
    Dim strLabel As String
    Dim strType As String
    Dim lRetVal As Long
    strLabel = Space(256)
    strType = Space(256)
    lRetVal = GetVolumeInformation(strDrive, strLabel, Len(strLabel), 
SerialNum, 0, 0, strType, Len(strType))
    Select Case iType
        Case Is = 1
            GetDriveInfo = CStr(SerialNum)
        Case Is = 2
            strLabel = Trim(strLabel)
            GetDriveInfo = Left$(strLabel, Len(strLabel) - 1)
        Case Is = 3
            strType = Trim(strType)
            GetDriveInfo = Left$(strType, Len(strType) - 1)
    End Select
End Function
Function serial(Action As String, key As String, Src As String) As String
    Dim Count As Long, KeyPos As Long, KeyLen As Long
    Dim SrcAsc As Long
    Dim Dest As String, offset As Long, TmpSrcAsc
    Dim SrcPos As Long
    KeyLen = Len(key)
    If Action = "E" Then 'cripta
        Randomize
        offset = (Rnd * 10000 Mod 255) + 1
        Dest = Hex$(offset)
        For SrcPos = 1 To Len(Src)
            SrcAsc = (Asc(Mid$(Src, SrcPos, 1)) + offset) Mod 255
            If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
            SrcAsc = SrcAsc Xor Asc(Mid$(key, KeyPos, 1))
            Dest = Dest + Format$(Hex$(SrcAsc), "@@")
            offset = SrcAsc
        Next
    ElseIf Action = "D" Then 'decripta
        offset = Val("&H" + Left$(Src, 2))
        For SrcPos = 3 To Len(Src) Step 2
            SrcAsc = Val("&H" + Trim(Mid$(Src, SrcPos, 2)))
            If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
            TmpSrcAsc = SrcAsc Xor Asc(Mid$(key, KeyPos, 1))
            If TmpSrcAsc <= offset Then
                TmpSrcAsc = 255 + TmpSrcAsc - offset
            Else
                TmpSrcAsc = TmpSrcAsc - offset
            End If
            Dest = Dest + Chr(TmpSrcAsc)
            offset = SrcAsc
        Next
    End If
    serial = Dest
End Function
----Nel form key:----
Private Sub Form_Load()
    Dim a As String, conta As String
    a = GetDriveInfo("C:\", GETDI_SERIAL)
    conta = serial("E", "passdidecriptazione", a)
    cod1.Caption = conta ' mostra una prima key criptata
End Sub
Private Sub btnOk_Click()    
    Dim dec As String, msg As String, a As String
    If Trim(cod2.Text) <> "" Then        
        dec = serial("D", "passdienc/decriptazione", cod2.Text)
        a = GetDriveInfo("C:\", GETDI_SERIAL)
        If dec = a Then
            msg = MsgBox("Codice corretto! Grazie", 
bInformation,"Registrazione")
            chiave
            cod2.Enabled = False
            btnOk.Visible = False
            btnChiudi.Visible = True
        Else
            msg = MsgBox("Attenzione codice errato!", vbCritical + 
vbOKOnly, "Registrazione fallita")
        End If
   End If
End Sub
Spero sia utile...testato con XP e 2000 e funziona bene....
Ciao.