AW: Passwortcountdown
15.10.2006 19:33:17
thomas
Hi Konni,
in ein Modul deines programmes
Option Explicit
Option Private Module
Public
Sub DatumsCheck()
Dim ersterAufruf As Date
If GetSetting("TEST", "Einstellungen", "ErsterAufruf") = "31.12.9999" Then Exit Sub
If GetSetting("TEST", "Einstellungen", "ErsterAufruf") = "" Then
'setzen des Datums
SaveSetting "TEST", "Einstellungen", "ErsterAufruf", Format(Date, "dd.mm.yyyy")
End If
'Check ob noch Gültig
ersterAufruf = GetSetting("TEST", "Einstellungen", "ErsterAufruf")
MsgBox "Der erste Aufruf war am " & ersterAufruf
If DateDiff("d", DateValue(ersterAufruf), Date) > 30 Then
If Application.InputBox("Der Testzeitraum ist vorbei!" & vbLf _
& "Geben Sie den Productkey ein, den Sie " & vbLf _
& "bei Kollege/in XYZ für dieses Programm erhalten," & vbLf _
& "in das vorgesehene Feld ein, dann können Sie" & vbLf _
& "das Programm unbegrenzt verwenden" & vbLf _
& "Productkey Eingabe Kollege XYZ") = "TEST" Then
SaveSetting "TEST", "Einstellungen", "ErsterAufruf", "31.12.9999"
Else
ThisWorkbook.Saved = True
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End If
Else
MsgBox "Sie haben noch " & 30 - DateDiff("d", DateValue(ersterAufruf), Date) & " Tage zum Testen!"
End If
End Sub
Es wird in die Registry der erste Aufruf geschrieben. Wenn nach Ablauf von 30 Tagen das Programm gestartet wird muss man das Passwort (im Bsp TEST) eingeben dann ist es unbegrenzt lauffähig.
Habe dieses Makro mal vor einiger Zeit hier im Forum gefunden und leicht abgewandelt. Wir verwenden das ganze in der Firma für neue Mitarbeiter. Funzt problemlos.
Gruß
Thomas