Usuário com melhor resposta
Detectar Alteração na Data do Computador

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)
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.
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 22:08
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 22:08
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/
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator quarta-feira, 26 de outubro de 2011 20:10
-
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 -
-
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.
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 22:08
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 22:08