Retornar data e Hor...
 
Notifications
Clear all

Retornar data e Hora do Servidor  

  RSS

Fernando Fernandes
(@fernandofernandes)
Illustrious Member
Entrou: 12 anos atrás
Posts: 44273
12/04/2010 7:05 am  

Olá pessoal!

Sou um pouco leigo no assunto de conexões, porém a todo momento preciso ter que me virar aqui na empresa. Sabem como é.. rs

Criei alguns aplicativos em VBA (Excel) conectados a um BD (Access), que por sua vez fica em um dos drivers aqui da empresa (N:).

O que ocorre é que é essencial para o funcionamento, que as datas e horas sejam comuns, pos qualquer mudança em uma das máquinas dos usuários, desconfigura todo o processo...

Como poderia fazer para usar apenas a data do servidor, para os aplicativos?

Abs!1

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel


ResponderCitar (Quote)
Fernando Fernandes
(@fernandofernandes)
Illustrious Member
Entrou: 12 anos atrás
Posts: 44273
12/04/2010 5:46 pm  

segue script necessário....

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

´chamando a função para obter a hora
Private Sub Command1_Click()
   'aqui você informa o nome do seu servidor
  Data = HoraServidor("\macoratti11a81")
  Text1.Text = Data
End Sub

creditos: www.macoratti.net

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel


ResponderCitar (Quote)
Fernando Fernandes
(@fernandofernandes)
Illustrious Member
Entrou: 12 anos atrás
Posts: 44273
22/04/2010 11:32 am  

Perfeito, funcionou!

Muito obrigado mesmo!

Abração!!!

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel


ResponderCitar (Quote)
Compartilhar: