Problemstellung:

Manchmal will man ein eigenes Programm erstmal nur als Demo weitergeben.
Nun ist das mit VB6 kein großes Problem.
Mit normalem MS-Access gibt es verschiedene Wege, die aber alle nicht 100 %ig sicher sind.
Grundvorraussetzung ist die Weitergabe als MDE-Datei, da ich keinerlei Programmcode sichtbar ist
und manipuliert werden kann.
Eine Lösung wäre die Anzahl von DS in einer Tabelle beschränken und diesen Wert mittels DCount zu prüfen.
Die beiden Lösungen, die hier vorstellen möchte, gehen einen etwas anderen Weg.

Ich hab mal 4 Möglichkeiten vorbereitet.

Um es aber gleich vorweg zu nehmen, es gibt keine absolute Sicherheit das dies jemand knackt.

1. DB startet nur einen bestimmten Zeitraum
1.1 Wert und Prüfung erfolgt über eine Private Property
1.2 Wert und Prüfung erfolgt über einen Eintrag in der Registry

2. DB kann nur eine bestimmte Anzahl von Starts ausgeführt werden
2.1 Wert und Prüfung erfolgt über eine Private Property
2.2 Wert und Prüfung erfolgt über einen Eintrag in der Registry

Voraussetzungen:

Das Bsp ist ab A00 lauffähig.

sValue = GetProp("Testtime")

Fehlt die Property wird sie mit dem verschlüsselten aktuellem Datum erstellt

SetProp "Testtime", dbText, Encrypt(sDate, sPWD)

Ist die Property vorhanden wird diese ausgelesen und entschlüsselt  

varTemp = Decrypt(sValue, sPWD)dateTemp = DateSerial(Right(varTemp, 2), Mid(varTemp, 3, 2), Left(varTemp, 2
intDays = DateDiff("d", Date, dateTemp)
sValue = GetProp("Testtime")

If intDays < (intCountDays * -1) Then
        MsgBox "Testzeitraum abgelaufen"
        DoCmd.Quit
Else
        MsgBox "Sie können das Programm noch " & intCountDays + intDays & " Tage testen"
End If

Ist der Wert der Konstanten überschritten wird das Programm geschlossen. Die Sache hat aber einen Haken.
Nach jeder Neuinstallation des Programms fehlt die Property und der Zeitraum beginnt von vorn.
Da wäre die Lösung mit der Registry besser.

Registry Version:
Mit den Standardfunktionen aus Access „GetSetting“ und „SaveSetting“ kommt man nicht weit, da hier
nur im Standard VBA Verzeichnis gespeichert wird und die findet jeder.
Deshalb die etwas aufwendigere Lösung mittels API.
Wichtig wäre das die Schlüsselbezeichnungen keinen Hinweis auf das eigene Programm zulassen.
Im Load Ereignis des Startforms wird zuerst geprüft ob der Registryeintrag (kann beliebig verändert werden),
bereits vorhanden ist.

1. Parameter: Hauptschlüssel : z.B. HKEY_CURRENT_USER
2. Parameter: Schlüsselpfad : z.B. WinApp
3. Parameter: Schlüsselname: z.B. WinAppValue

sTemp = fWertLesen(HKEY_CURRENT_USER, "WinApp", "WinAppValue")

Fehlt der Registryeintrag wird dieser mit dem verschlüsselten aktuellem Datum erstellt.

If sTemp = "" Then
    fStringSpeichern HKEY_CURRENT_USER, "WinApp", "WinAppValue", sValue

Ist der Registryeintrag vorhanden wird diese ausgelesen und entschlüsselt.

sDateTemp = Decrypt(sTemp, sPWD)
dateTemp = DateSerial(Right(sDateTemp, 2), Mid(sDateTemp, 3, 2), Left(sDateTemp, 2))
intDays = DateDiff("d", Date, dateTemp)

Danach erfolgt der Vergleich des aktuellen Datums mit dem gespeicherten Wert des Registryeintrags

If intDays < (intCountDays * -1) Then
   MsgBox "Testzeitraum abgelaufen"
   DoCmd.Quit
Else
   MsgBox "Sie können das Programm noch " & intCountDays + intDays & " Tage testen"
End If

Ist der Wert der Konstanten überschritten wird das Programm geschlossen.

Anzahl Programmstarts:
Die Festlegung der Konstanten für das Verschlüsselungspasswort ist die Gleiche wie oben.
In den Programmstartvarianten wird in der Konstanten „intCountStart“ die Anzahl der Programmstarts festgelegt,
hier im Bsp 30 Tage.
Die Konstante „intFactor“ ist als Faktor für Verschlüsselung gedacht, hier im Bsp 221.
Es ist darauf zuachten das die Multiplikation der beiden Konstanten nicht den Wertebereich des
IntegerTyps, also 32768, nicht überschreitet.
Property Version:
Im Load Ereignis des Startforms wird zuerst geprüft ob die Property, hier „CountStart“ (kann beliebig verändert werden),
bereits vorhanden ist.

sValue = GetProp("CountStart")

Fehlt die Property wird sie mit dem Wert 1 * dem Faktor verschlüsselt erstellt.

If fProp = False Then
    intValueTemp = 1 * intFactor
    SetProp "CountStart", dbText, Encrypt(CStr(intValueTemp), sPWD)

Ist die Property vorhanden wird diese ausgelesen und entschlüsselt und um den Wert 1 erhöht.
Der neue Wert wird gleich wieder verschlüsselt in die Property zurück geschrieben

sValueTemp = Decrypt(sValue, sPWD)
intValueTemp = CInt(sValueTemp) / intFactor
intValueTemp = intValueTemp + 1
SetProp "CountStart", dbText, Encrypt(CStr(intValueTemp * intFactor), sPWD)

Danach erfolgt der Vergleich mit dem Wert der Konstanten für die max. Anzahl der Starts mit dem
gespeicherten Wert der Property.

intDiff = intCountStart - intValueTemp
If intDiff < 0 Then
     MsgBox "Testzeitraum abgelaufen"
     DoCmd.Quit
Else
     MsgBox "Sie können das Programm noch " & intDiff & " mal starten"
End If

Ist der Wert bei 0 angekommen wird das Programm geschlossen.
Die Sache hat aber auch hier den gleichen Haken.
Nach jeder Neuinstallation des Programms fehlt die Property und die Zählung beginnt von vorn.

Registry Version:
Hier gelten die gleichen Regeln bzw. Hinweise wie bei der Zeitraumvariante.
Die benötigten Konstanten sind die gleichen wie in der Propertyvariante.
Im Load Ereignis des Startforms wird zuerst geprüft ob der Registryeintrag (kann beliebig verändert werden),
bereits vorhanden ist.
1. Parameter: Hauptschlüssel : z.B. HKEY_CURRENT_USER
2. Parameter: Schlüsselpfad : z.B. WinApp
3. Parameter: Schlüsselname: z.B. WinAppStart

sTemp = fWertLesen(HKEY_CURRENT_USER, "WinApp", "WinAppStart")

Fehlt der Registryeintrag wird dieser mit dem Wert 1 * dem Faktor verschlüsselt erstellt.

If sTemp = "" Then
    intValueTemp = 1 * intFactor
    sValue = Encrypt(CStr(intValueTemp), sPWD)
    fStringSpeichern HKEY_CURRENT_USER, "WinApp", "WinAppStart", sValue
    intValueTemp = 1

Ist der Registryeintrag vorhanden wird dieser ausgelesen und entschlüsselt und um den Wert 1 erhöht.
Der neue Wert wird gleich wieder verschlüsselt in den Registryeintrag zurück geschrieben.

sValueTemp = Decrypt(sTemp, sPWD)
intValueTemp = CInt(sValueTemp) / intFactor
intValueTemp = intValueTemp + 1
sValue = Encrypt(CStr(intValueTemp * intFactor), sPWD)
fStringSpeichern HKEY_CURRENT_USER, "WinApp", "WinAppStart", sValue

Danach erfolgt der Vergleich mit dem Wert der Konstanten für die max. Anzahl der Starts mit dem gespeicherten
Wert der Registry.

intDiff = intCountStart - intValueTemp
If intDiff < 0 Then
     MsgBox "Testzeitraum abgelaufen"
     DoCmd.Quit
Else
     MsgBox "Sie können das Programm noch " & intDiff & " mal starten"
End If

Ist der Wert der Konstanten überschritten wird das Programm geschlossen.

Um bei Testzwecken die Properties bzw. Registryeinträge zu löschen geht man so vor:
Für Registry:
In eine beliebige Access-DB das Modul „mod_Registry“ kopieren und daraus die Sub „fWerteLoeschen“ aufrufen.
z.B.:

fWerteLoeschen HKEY_CURRENT_USER, "WinApp", "WinAppValue"

Aufgrund dieser Lösung ist es erforderlich das andere Pfade als in dem Bsp verwendet werden.
Es kann nur der Schüssel gelöscht werden wenn dieser bekannt ist.

Für Property:
In eine beliebige Access-DB die folgende Sub kopieren:

Public Sub DeleteProp(strDBPfad As String, strProp As String)
'*******************************************
'Name:      GetProp (Sub)
'Purpose:   Auslesen von Datenbank Einstellungen
'Author:    Thomas Keßler
'Date:      Dezember 15, 2002, 11:00:15
'Inputs:    strDBPfad = Datenbank mit komplettem Pfad, strprop= Die Eigenschaft die 
'           gelöscht werden soll
'*******************************************
Dim wsp As DAO.Workspace
Dim db As DAO.DATABASE

On Error GoTo Err_Prop
    Set wsp = DBEngine.Workspaces(0)
    Set db = wsp.OpenDatabase(strDBPfad)
    
    db.Properties.Delete (strProp)
    db.Close

    GoTo Err_Ende

Err_Ende:
    Exit Sub
Err_Prop:
    If Err.Number = 3270 Then
        Exit Sub
  Else
        Dim strErrString As String
        strErrString = "Error Information..." & vbcrlf
        strErrString = strErrString & "Error#: " & Err.Number & vbcrlf
        strErrString = strErrString & " Description: " & Err.Description & vbcrlf
        MsgBox strErrString, vbCritical + vbOKOnly, _
               "Error in Modul mod_Property in Sub: GetProp"
        Resume Err_Ende
    End If
End Sub

Der Aufruf sähe z.B. so aus:

DeleteProp "C:\DeinPfad\DeineDB.mdb", "Testtime"

Auch hier gilt andere Bezeichnungen zu verwenden, denn es kann nur gelöscht werden wenn der Name der Property bekannt ist.

Ich übernehme aber keinerlei Haftung, für entstandene Schäden durch die Verwendung dieses Beispiels und/oder durch Dritte

Dateien:

Userverwaltung II Beliebt

(0 Stimmen)

Beispiel-DB für eine Userverwaltung mit verschlüsselten Passwörtern und individuellen verschlüsselten Formularrechten.

ab A00

Die Setup-Datei enthält eine Version ab A00

 05.02.2018

 632.44 KB

 3.880

Download

Ähnliche Artikel

You have no rights to post comments