USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Miscelâneas)

Título da Dica:  Configurar uma aplicação para ShareWare
Postada em 3/2/2003 por Felipe            
Option Explicit

Public Function DateGood(NumDays As Integer) As Boolean
    'O Proposito desse modulo é colocar uma data limite
'na sua aplicação
    'Esse modulo não pode ser destruido pela volta da data
    'Apenas chame a função DateGood quando seu aplicativo for rodado a primeira vez
    'passando como parametro os dias de registro    '
    'Ex: If DateGood(30)=False Then
    ' Roda Aplicação
    ' End if
    'Parametro do Registro:
    ' CRD: Current Run Date
    ' LRD: Last Run Date
    ' FRD: First Run Date

    Dim TmpCRD As Date
    Dim TmpLRD As Date
    Dim TmpFRD As Date

    TmpCRD = Format(Now, "m/d/yy")
    TmpLRD = GetSetting(App.EXEName, "Param", "LRD", "1/1/2000")
    TmpFRD = GetSetting(App.EXEName, "Param", "FRD", "1/1/2000")
    DateGood = False

    'Se for o primeiro load do form escreva os sets iniciais para o registro
    If TmpLRD = "1/1/2000" Then
        SaveSetting App.EXEName, "Param", "LRD", TmpCRD
        SaveSetting App.EXEName, "Param", "FRD", TmpCRD
    End If
    'Leia LRD e FRD do registro
    TmpLRD = GetSetting(App.EXEName, "Param", "LRD", "1/1/2000")
    TmpFRD = GetSetting(App.EXEName, "Param", "FRD", "1/1/2000")

    If TmpFRD > TmpCRD Then 'Relogio do sistema sofreu alteração
        DateGood = False
    ElseIf Now > DateAdd("d", NumDays, TmpFRD) Then 'Prazo estourou
        DateGood = False
    ElseIf TmpCRD > TmpLRD Then 'Tudo OK escrever nova data LRD
        SaveSetting App.EXEName, "Param", "LRD", TmpCRD
        DateGood = True
    ElseIf TmpCRD = Format(TmpLRD, "m/d/yy") Then
        DateGood = True
    Else
        DateGood = False
    End If
End Function

Private Sub Form_Activate()
    If Not DateGood(30) Then
        MsgBox "Trial Period Expired!", vbExclamation, "Unregistered application"
        Unload Me
    End If
End Sub
 


CyberWEB Network Ltda.    © Copyright 2000-2017   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página