none
Detectar Alteração na Data do Computador RRS feed

  • Pergunta

  • Estou fazendo uma planilha e uso o VBA para verificar se ela já expirou.

    Para fazer isso verifico a data atual (do computador) com a data de vencimento.

    O problema é que o usuário pode alterar a data do computador e manipular a validade da licença.

    Então gostaria de saber se há outro meio de fazer isso, ou, verificar uma possível alteração de data no sistema.

     

    ps: sou meio leigo no assunto...

    • Movido Eder Costa segunda-feira, 17 de outubro de 2011 16:12 De: Vb.net & Visual Basic (De:VB.NET e Visual Basic)
    terça-feira, 11 de outubro de 2011 15:45

Respostas

  •  

    Este exemplo retorna a hora de um determinado computador utilizado como servidor de hora

    de uma olhada e veja se lhe auxilia na resolução do seu problema


    Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" (ByVal server As String, buffer As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (buffer As Any) As Long
    
    Private Type TIME_OF_DAY
      t_elapsedt As Long
      t_msecs As Long
      t_hours As Long
      t_mins As Long
      t_secs As Long
      t_hunds As Long
      t_timezone As Long
      t_tinterval As Long
      t_day As Long
      t_month As Long
      t_year As Long
      t_weekday As Long
    End Type
    
    Public Function HoraServidor(ByVal pNomeServidor As String) As Variant
    
    Dim t As TIME_OF_DAY
    Dim tPtr As Long
    Dim Resultado As Long
    Dim szServer As String
    Dim dataServidor As Date
    
    On Error GoTo trata_erro
    
    If Left(pNomeServidor, 2) = "\\" Then
       szServer = StrConv(pNomeServidor, vbUnicode)
    Else
       szServer = StrConv("\\" & pNomeServidor, vbUnicode)
    End If
    
    Resultado = NetRemoteTOD(szServer, tPtr)
    
    If Resultado = 0 Then
    
      Call CopyMemory(t, ByVal tPtr, Len(t))
    
      dataServidor = DateSerial(70, 1, 1) + (t.t_elapsedt / 60 / 60 / 24)
      dataServidor = dataServidor - (t.t_timezone / 60 / 24)
      NetApiBufferFree (tPtr)
      HoraServidor = dataServidor
    
    Else
    
      MsgBox "Não foi possivel obter a hora do servidor"
    
    End If
    
    Exit Function
    
    trata_erro:
    MsgBox Err.Number & " - " & Err.Description
    
    End Function
    
    
    
    Private Sub Workbook_Open()
    
    ' Insira o nome de um pc usado como servidor de horas
    data = HoraServidor("\\Seu PC\")
    MsgBox (data)
    
    End Sub

    Fonte:

    http://www.macoratti.net/vb_hserv.htm

    Att.

    quarta-feira, 19 de outubro de 2011 14:23

Todas as Respostas

  • Em VBA só usando Subclassing (http://vbcity.com/forums/t/112479.aspx) ou criando um timer que verifique de x em x tempo se a data foi alterada. Depois quando sair do ficheiro podia guardar a última data/hora de modo a verficar na próxima vez que abrir o ficheiro se a data é inferior. Acho que assim é bem mais simples.


    Jorge Paulino
    Visual Basic em Português
    http://www.jorgepaulino.com/

    terça-feira, 11 de outubro de 2011 20:48
  • Bem, com o timer é possível verificar mesmo quando a planilha estiver fechada?
    Essa sugestão de armazenar a última data/hora é boa, mas ainda assim é só a pessoa ajustar o relógio para a mesma data, e um minuto a mais que não vai haver como diferenciar...

    Percebi que quando altera a data fica no visualizador de eventos do windows, e tem até como relacionar uma tarefa. Porém tem como criar uma espécie de instalador para importar automaticamente essa tarefa para o computador, ou, criar um código no VBA que verifica esses eventos por ID?

     

    obrigado =D


    aa
    quinta-feira, 13 de outubro de 2011 03:46
  • Ninguém sabe como resolver?
    aa
    terça-feira, 18 de outubro de 2011 02:08
  •  

    Este exemplo retorna a hora de um determinado computador utilizado como servidor de hora

    de uma olhada e veja se lhe auxilia na resolução do seu problema


    Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" (ByVal server As String, buffer As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (buffer As Any) As Long
    
    Private Type TIME_OF_DAY
      t_elapsedt As Long
      t_msecs As Long
      t_hours As Long
      t_mins As Long
      t_secs As Long
      t_hunds As Long
      t_timezone As Long
      t_tinterval As Long
      t_day As Long
      t_month As Long
      t_year As Long
      t_weekday As Long
    End Type
    
    Public Function HoraServidor(ByVal pNomeServidor As String) As Variant
    
    Dim t As TIME_OF_DAY
    Dim tPtr As Long
    Dim Resultado As Long
    Dim szServer As String
    Dim dataServidor As Date
    
    On Error GoTo trata_erro
    
    If Left(pNomeServidor, 2) = "\\" Then
       szServer = StrConv(pNomeServidor, vbUnicode)
    Else
       szServer = StrConv("\\" & pNomeServidor, vbUnicode)
    End If
    
    Resultado = NetRemoteTOD(szServer, tPtr)
    
    If Resultado = 0 Then
    
      Call CopyMemory(t, ByVal tPtr, Len(t))
    
      dataServidor = DateSerial(70, 1, 1) + (t.t_elapsedt / 60 / 60 / 24)
      dataServidor = dataServidor - (t.t_timezone / 60 / 24)
      NetApiBufferFree (tPtr)
      HoraServidor = dataServidor
    
    Else
    
      MsgBox "Não foi possivel obter a hora do servidor"
    
    End If
    
    Exit Function
    
    trata_erro:
    MsgBox Err.Number & " - " & Err.Description
    
    End Function
    
    
    
    Private Sub Workbook_Open()
    
    ' Insira o nome de um pc usado como servidor de horas
    data = HoraServidor("\\Seu PC\")
    MsgBox (data)
    
    End Sub

    Fonte:

    http://www.macoratti.net/vb_hserv.htm

    Att.

    quarta-feira, 19 de outubro de 2011 14:23