Option Explicit
Dim MyTime, LastTime As Double
Private Sub Form_Load()
'Вот тут надо бы загрузить из файла настроек значение LastTime
MyTime = LastTime
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
LastTime = LastTime + MyTime
'А тут сохранить значение LastTime в файл
End Sub
Private Sub Timer1_Timer()
MyTime = MyTime + 1
If MyTime > 3600 Then MsgBox ("Ага, попались! А кто регистрироваться будет?"): Unload Me
End Sub
Люди добрые, вставайте на защиту программиста!!!
Так как был не опытен и планировал усовершенствование, то защиту туда поставил слабенькую:
Private Sub Workbook_Open()
On Error GoTo errHandle
Dim dDelDate As Date
dDelDate = #3/1/2007#
Dim dPredDate As Date
dPredDate = #2/1/2007#
If dDelDate < Now Then
MsgBox ("Срок действия надстроек истек, обратитесь к разработчику!")
ThisWorkbook.Close
Exit Sub
End If
If dPredDate < Now Then
' MsgBox ("Срок действия надстроек истекает 01.03.07, для получения новой, улучшенной версии обратитесь к разработчику.")
End If
Exit Sub
errHandle:
MsgBox Err.Description, vbCritical, "Ошибка № " & Err.Number
ThisWorkbook.Close
End Sub
Вся защита идёт по боку, когда меняешь системное время на компьютере, чем они непременно воспользовались.
У меня есть единственный шанс заменить программу на другую. ПОМОГИТЕ сделать хорошую защиту... может через реестр, а можем с помощью Windows можно как-нибудь запретить запуск программы с определённым именем...
Код:
Только вот я не понял, ты VB используешь или VBE? С одной стороны "exeшник", с другой "ThisWorkbook.Close"...
Действительно хорошая защита... каким образом ее можно сделать на VBA?? :confused: Если все скрипты можно отредактрировать...
[QUOTE=Mimino]вся программа, включая ехе-шник и отчеты работает через файл надстроек *.xla.[/QUOTE]
Как же ехе'шник получился в VBA? Из этого я сделал вывод, что Mimino использует VB, однако код подтверждает обратное.
А вообще есть функция Timer, которая также присутствует и VBA. Можно написать через нее. Вот так, например:
Код:
Option Explicit
Dim MyTime, LastTime As Double
Private Sub Workbook_Open()
...
MyTime = Timer
...
End Sub
Private Sub WorkBook_Close()
...
' Загружаем значение LastTime из файла настроек
...
MyTime = Timer - MyTime
LastTime = LastTime + MyTime
' Сохраняем значение LastTime
...
End Sub
Dim MyTime, LastTime As Double
Private Sub Workbook_Open()
...
MyTime = Timer
...
End Sub
Private Sub WorkBook_Close()
...
' Загружаем значение LastTime из файла настроек
...
MyTime = Timer - MyTime
LastTime = LastTime + MyTime
' Сохраняем значение LastTime
...
End Sub
Правда, если перевести время назад во время выполнения программы, все полетит к чертям. Можно как-то отловить перевод часов, но как?..