MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Dúvida no aplicativo Célula.

    Compartilhe
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Sab 10 Fev 2018, 17:50

    Boa tarde.
    No aplicativo Célula, disponibilizado pelo Avelino, alguém poderia dizer onde troco o prazo de 10 dias para 20, 30 ou mais.
    Já fucei tanto e reinstalei tudo...rs e não consegui.
    Obrigado

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Dom 11 Fev 2018, 10:49

    No módulo mod_Licença:


    Public Function fncValidadeCom(Optional prazo As Integer = 30) As Boolean

    e também a função

    Private Function fncTempoEsgotado(prazo As Integer) As Boolean

    Estude essas funções, veja as chamadas delas, tem função para o horário da web e função para quando está desconectado dela.


    [ ]'s
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Dom 11 Fev 2018, 15:32

    Obrigado.

    Mas vamos lá.
    No form principal troquei para:
    Código:

    Private Sub Form_Open(Cancel As Integer)
    'If fncValidadeCom(30) = False Then
    If fncValidade(30) = False Then
       Cancel = True
       DoCmd.Quit acQuitSaveNone
    End If
    Call fncAlteraBotao
    End Sub

    Nas funções informadas:
    1) Function fncValidadeCom
    Observo que o prazo, me parece ja estar em 30.

    Public Function fncValidadeCom(Optional prazo As Integer = 30) As Boolean
    Dim varReg As Variant
    Dim varRegIdx As Variant
    Dim varRegIda As Variant
    Dim varAcesso As Variant

    On Error GoTo trataerro
    booComercial = True
    Call fncContaAcesso

    'testa se tabela existe. Se não existir, gera erro 3078
    varReg = DLookup("campo1", "tblRegistro")

    'se ocorrer erro seguir em frente
    On Error Resume Next
    Set objReg = CreateObject("wscript.shell")
    varRegIdx = fncDeCripChave(objReg.RegRead(idx))
    If Err Then
       'ocorreu um erro - regitro idx não foi encontrado.
       'limpa o erro
       Err.Clear
       On Error GoTo trataerro
       varAcesso = Split(fncDeCripChave(DLookup("campo3", "tblregistro"), 2), ",")
       If varAcesso(0) > 0 Then
           'tempo decorrido maior que zero. Pode ser devido a um novo usuário acessando o computador, o que não é permitido.
           fncValidadeCom = False
           Exit Function
       Else
           'Gera nova chave com o intuito de solicitar novo registro.
           'O novo registro irá liberar novamente o aplicativo pelo prazo determinado.
           Call fncCriarChaveRegWin(prazo)
       End If
    Else
       varRegIda = fncDeCripChave(objReg.RegRead(ida), 2)
       If Err Then
           Err.Clear
           On Error GoTo trataerro
           Call fncCriarChaveRegWin(prazo)
       Else
           On Error GoTo trataerro
           If varRegIdx = varRegIda Then
               varRegIdx = Split(varRegIdx, ",")
               If (varRegIdx(1) & "," & varRegIdx(2)) = fncDeCripChave(DLookup("campo3", "tblRegistro"), 2) Then
                   If CInt(varRegIdx(1)) < prazo Then
                       If fncTempoEsgotado(prazo) = False Then
                           Set objReg = Nothing
                           fncValidadeCom = True
                           Exit Function
                       Else
                           Call fncCriarChaveRegWin(prazo, CLng(varRegIdx(3)))
                       End If
                   End If
               Else
                   Call fncCriarChaveRegWin(prazo)
               End If
           Else
               Call fncCriarChaveRegWin(prazo)
           End If
       End If
    End If
    DoCmd.OpenForm "frmRegistro", , , , , acDialog, 5
    fncValidadeCom = booRegistrado
    Set objReg = Nothing

    sair:
       Exit Function
    trataerro:
       Select Case Err.Number
           Case 3078, 2471, 9, 3075
               MsgBox "O aplicativo sofreu uma violação e será encerrado...", vbCritical, "Aviso"
           Case Else
               MsgBox Err.Description & " / " & Err.Number
       End Select
       fncValidadeCom = False
       Resume sair
    End Function

    2) Private Function fncTempoEsgotado

    Alterei o seguinte:

    Private Function fncTempoEsgotado(prazo As Integer) As Boolean
    Dim varRegIdx As Variant
    Dim varRegIda As Variant
    Dim varData As Variant
    Dim strValor As String
    Dim varAcesso As Variant
    Dim intCed%, intTd%, intHd%, lngDd&, lngCm&
    Dim varSoma As Variant

    On Error GoTo trataerro

    If fncCapturaDataWeb > [color=#ff0000]30[/color] Then


    A programação prossegue até o final da verificação on line, sem EU ter alterado nada....

    Depois passa para a verificação na ausência do on line..
    Ai, vem toda uma linguagem de programação que sinceramente, não possuo conhecimento.

    No final a função ficou assim:


    Private Function fncTempoEsgotado(prazo As Integer) As Boolean
    Dim varRegIdx As Variant
    Dim varRegIda As Variant
    Dim varData As Variant
    Dim strValor As String
    Dim varAcesso As Variant
    Dim intCed%, intTd%, intHd%, lngDd&, lngCm&
    Dim varSoma As Variant

    On Error GoTo trataerro

    If fncCapturaDataWeb > 30 Then
       varData = Split(fncDeCripChave(DLookup("campo3", "tblRegistro"), 2), ",")
       If regWeb.varValor >= CLng(varData(1)) Then
           Set objReg = CreateObject("wscript.shell")
           varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
           strValor = varRegIdx(0)
           strValor = strValor & "," & (varRegIdx(1) + (regWeb.varValor - varData(1)))
           strValor = strValor & "," & regWeb.varValor & "," & varRegIdx(3)
           objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
           objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
           Call Sleep(200)
           varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
           CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave(varRegIdx(1) & "," & varRegIdx(2), 2) & "';"
           varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
           CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & ",0,0,0", 2) & "';"
           If CInt(varRegIdx(1)) >= prazo Then
               fncTempoEsgotado = True
           Else
               fncTempoEsgotado = False
           End If
           Set objReg = Nothing
           Exit Function
       End If
    End If
    'sem retorno da internet
    Set objReg = CreateObject("wscript.shell")
    varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
    If CLng(Date) < CLng(varRegIdx(2)) Then
       '-------------------------------------
       'Vou me basear numa estatística de uso
       '-------------------------------------
       'capturando dados estatísticos da tabela registro
       varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
       'Data do sistema for diferente da data do dia
       If CLng(Date) <> CLng(varAcesso(2)) Then
           'gravo quantos vezez por dia o usuário abre o programa
           'número de acessos ao progrma dividido pelo tempo de uso decorrido
           If CInt(varRegIdx(1)) = 0 Then
               intCed = 0
           Else
               intCed = Int(CInt(varAcesso(0)) / CInt(varRegIdx(1))) - 1
           End If
       Else
           'se a hora for inferior a hora do último acesso
           If CInt((Hour(Now) * 60 + Minute(Now))) < CInt(varAcesso(3)) Then
               intCed = 0
           Else
               'se tem direito a acesso sem contagem
               'por exemplo, se o usuário abre o programa três vezes por dia então só é contabilizado apenas um acesso
               'os outros dois acessos no mesmo dia ficam então sem contagem
               If CInt(varAcesso(1)) > 0 Then
                   intCed = varAcesso(1) - 1
                   intHd = ((Hour(Now) * 60) + Minute(Now))
                   CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & "," & intCed & "," & varAcesso(2) & "," & intHd, 2) & "';"
                   fncTempoEsgotado = False
                   Exit Function
               Else
                   If CInt(varRegIdx(1)) = 0 Then
                       intCed = 0
                   Else
                       intCed = Int(CInt(varAcesso(0)) / CInt(varRegIdx(1))) - 1
                   End If
               End If
           End If
       End If
       intTd = CInt(varRegIdx(1)) + Int((CInt(varRegIdx(1)) / CInt(varAcesso(0))) + 1)
       intHd = ((Hour(Now) * 60) + Minute(Now))
       lngDd = CLng(Date)
       strValor = varRegIdx(0)
       strValor = strValor & "," & intTd
       strValor = strValor & "," & varRegIdx(2) & "," & varRegIdx(3)
       objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
       objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
       Call Sleep(200)
       CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave(intTd & "," & varRegIdx(2), 2) & "';"
       Call Sleep(200)
       CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & "," & intCed & "," & lngDd & "," & intHd, 2) & "';"
       If CInt(varRegIdx(1)) >= prazo Then
           fncTempoEsgotado = True
       Else
           fncTempoEsgotado = False
       End If
    Else
       If CLng(Date) = CLng(varRegIdx(2)) Then
           varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
           intHd = ((Hour(Now) * 60) + Minute(Now))
           If intHd < CInt(varAcesso(3)) Then
               strValor = varRegIdx(0)
               strValor = strValor & "," & varRegIdx(1) + 1
               strValor = strValor & "," & varRegIdx(2) & "," & varRegIdx(3)
               objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
               objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
               Call Sleep(200)
               CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave((varRegIdx(1) + 1) & "," & varRegIdx(2), 2) & "';"
           End If
           Call Sleep(200)
           CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & "," & varAcesso(1) & "," & varAcesso(2) & "," & intHd, 2) & "';"
           fncTempoEsgotado = False
       Else
           strValor = varRegIdx(0)
           strValor = strValor & "," & (varRegIdx(1) + (CLng(Date) - varRegIdx(2)))
           strValor = strValor & "," & CLng(Date) & "," & varRegIdx(3)
           Set objReg = CreateObject("wscript.shell")
           objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
           objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
           Call Sleep(200)
           varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
           CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave(varRegIdx(1) & "," & varRegIdx(2), 2) & "';"
           Call Sleep(200)
           varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
           CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & ",0,0,0", 2) & "';"
           If CInt(varRegIdx(1)) >= prazo Then
               fncTempoEsgotado = True
           Else
               fncTempoEsgotado = False
           End If
       End If
    End If
    Set objReg = Nothing

    sair:
       Exit Function
    trataerro:
       MsgBox Err.Description & " / " & Err.Number
       fncTempoEsgotado = True
       Resume sair
    End Function

    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Dom 11 Fev 2018, 15:33

    Permanecendo com os mesmos dez dias,

    Obrigado,

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Dom 11 Fev 2018, 16:19

    Funcionou?




    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Dom 11 Fev 2018, 16:30

    Não...

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Dom 11 Fev 2018, 18:56

    Veja


    Tem duas funções para testar o tempo de uso

    e abaixo, tem as chamadas para elas:

    Private Sub Form_Open(Cancel As Integer)
    'Essa primeira é para alugar o te aplicativo por um determinado período.
    'If fncValidadeCom(30) = False Then

    'Essa segunda é para determinar o tempo de teste (trial)
    If fncValidade(10) = False Then
       Cancel = True
       DoCmd.Quit acQuitSaveNone
    End If


    Vi que tem a primeira função:

    Public Function fncValidadeCom(Optional prazo As Integer = 0) As Boolean

    Mas não vi a segunda:

    Public Function fncValidade(Optional prazo As Integer = 0) As Boolean

    É provável que não copiou essa segunda.

    Caso a tenha e não conseguiu

    Anexe a tabela,  formulário e o módulo mod_Licença para analise.
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Dom 11 Fev 2018, 19:36

    Qdo postei....
    Postei assim.
    Todavia no site entrou diferente...



    Estou refazendo

    Obrigado.

    Mas vamos lá.
    No form principal troquei para:

    Private Sub Form_Open(Cancel As Integer)
    'If fncValidadeCom(30) = False Then
    If fncValidade(30) = False Then
    Cancel = True
    DoCmd.Quit acQuitSaveNone
    End If
    Call fncAlteraBotao
    End Sub

    Nas funções:
    1) Function fncValidadeCom
    Observo que o prazo, me parece ja estar em 30.

    Public Function fncValidadeCom(Optional prazo As Integer = 30) As Boolean
    Dim varReg As Variant
    Dim varRegIdx As Variant
    Dim varRegIda As Variant
    Dim varAcesso As Variant

    On Error GoTo trataerro
    booComercial = True
    Call fncContaAcesso

    'testa se tabela existe. Se não existir, gera erro 3078
    varReg = DLookup("campo1", "tblRegistro")

    'se ocorrer erro seguir em frente
    On Error Resume Next
    Set objReg = CreateObject("wscript.shell")
    varRegIdx = fncDeCripChave(objReg.RegRead(idx))
    If Err Then
    'ocorreu um erro - regitro idx não foi encontrado.
    'limpa o erro
    Err.Clear
    On Error GoTo trataerro
    varAcesso = Split(fncDeCripChave(DLookup("campo3", "tblregistro"), 2), ",")
    If varAcesso(0) > 0 Then
    'tempo decorrido maior que zero. Pode ser devido a um novo usuário acessando o computador, o que não é permitido.
    fncValidadeCom = False
    Exit Function
    Else
    'Gera nova chave com o intuito de solicitar novo registro.
    'O novo registro irá liberar novamente o aplicativo pelo prazo determinado.
    Call fncCriarChaveRegWin(prazo)
    End If
    Else
    varRegIda = fncDeCripChave(objReg.RegRead(ida), 2)
    If Err Then
    Err.Clear
    On Error GoTo trataerro
    Call fncCriarChaveRegWin(prazo)
    Else
    On Error GoTo trataerro
    If varRegIdx = varRegIda Then
    varRegIdx = Split(varRegIdx, ",")
    If (varRegIdx(1) & "," & varRegIdx(2)) = fncDeCripChave(DLookup("campo3", "tblRegistro"), 2) Then
    If CInt(varRegIdx(1)) < prazo Then
    If fncTempoEsgotado(prazo) = False Then
    Set objReg = Nothing
    fncValidadeCom = True
    Exit Function
    Else
    Call fncCriarChaveRegWin(prazo, CLng(varRegIdx(3)))
    End If
    End If
    Else
    Call fncCriarChaveRegWin(prazo)
    End If
    Else
    Call fncCriarChaveRegWin(prazo)
    End If
    End If
    End If
    DoCmd.OpenForm "frmRegistro", , , , , acDialog, 5
    fncValidadeCom = booRegistrado
    Set objReg = Nothing

    sair:
    Exit Function
    trataerro:
    Select Case Err.Number
    Case 3078, 2471, 9, 3075
    MsgBox "O aplicativo sofreu uma violação e será encerrado...", vbCritical, "Aviso"
    Case Else
    MsgBox Err.Description & " / " & Err.Number
    End Select
    fncValidadeCom = False
    Resume sair
    End Function

    2) Private Function fncTempoEsgotado

    Alterei o seguinte:

    Private Function fncTempoEsgotado(prazo As Integer) As Boolean
    Dim varRegIdx As Variant
    Dim varRegIda As Variant
    Dim varData As Variant
    Dim strValor As String
    Dim varAcesso As Variant
    Dim intCed%, intTd%, intHd%, lngDd&, lngCm&
    Dim varSoma As Variant

    On Error GoTo trataerro

    If fncCapturaDataWeb > 30 Then


    A programação prossegue até o final da verificação on line, sem EU ter alterado nada....

    Depois passa para a verificação na ausência do on line..
    Ai, vem toda uma linguagem de programação que sinceramente, não possuo conhecimento.

    No final a função ficou assim:


    Private Function fncTempoEsgotado(prazo As Integer) As Boolean
    Dim varRegIdx As Variant
    Dim varRegIda As Variant
    Dim varData As Variant
    Dim strValor As String
    Dim varAcesso As Variant
    Dim intCed%, intTd%, intHd%, lngDd&, lngCm&
    Dim varSoma As Variant

    On Error GoTo trataerro

    If fncCapturaDataWeb > 30 Then
    varData = Split(fncDeCripChave(DLookup("campo3", "tblRegistro"), 2), ",")
    If regWeb.varValor >= CLng(varData(1)) Then
    Set objReg = CreateObject("wscript.shell")
    varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
    strValor = varRegIdx(0)
    strValor = strValor & "," & (varRegIdx(1) + (regWeb.varValor - varData(1)))
    strValor = strValor & "," & regWeb.varValor & "," & varRegIdx(3)
    objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
    objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
    Call Sleep(200)
    varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
    CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave(varRegIdx(1) & "," & varRegIdx(2), 2) & "';"
    varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
    CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & ",0,0,0", 2) & "';"
    If CInt(varRegIdx(1)) >= prazo Then
    fncTempoEsgotado = True
    Else
    fncTempoEsgotado = False
    End If
    Set objReg = Nothing
    Exit Function
    End If
    End If
    'sem retorno da internet
    Set objReg = CreateObject("wscript.shell")
    varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
    If CLng(Date) < CLng(varRegIdx(2)) Then
    '-------------------------------------
    'Vou me basear numa estatística de uso
    '-------------------------------------
    'capturando dados estatísticos da tabela registro
    varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
    'Data do sistema for diferente da data do dia
    If CLng(Date) <> CLng(varAcesso(2)) Then
    'gravo quantos vezez por dia o usuário abre o programa
    'número de acessos ao progrma dividido pelo tempo de uso decorrido
    If CInt(varRegIdx(1)) = 0 Then
    intCed = 0
    Else
    intCed = Int(CInt(varAcesso(0)) / CInt(varRegIdx(1))) - 1
    End If
    Else
    'se a hora for inferior a hora do último acesso
    If CInt((Hour(Now) * 60 + Minute(Now))) < CInt(varAcesso(3)) Then
    intCed = 0
    Else
    'se tem direito a acesso sem contagem
    'por exemplo, se o usuário abre o programa três vezes por dia então só é contabilizado apenas um acesso
    'os outros dois acessos no mesmo dia ficam então sem contagem
    If CInt(varAcesso(1)) > 0 Then
    intCed = varAcesso(1) - 1
    intHd = ((Hour(Now) * 60) + Minute(Now))
    CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & "," & intCed & "," & varAcesso(2) & "," & intHd, 2) & "';"
    fncTempoEsgotado = False
    Exit Function
    Else
    If CInt(varRegIdx(1)) = 0 Then
    intCed = 0
    Else
    intCed = Int(CInt(varAcesso(0)) / CInt(varRegIdx(1))) - 1
    End If
    End If
    End If
    End If
    intTd = CInt(varRegIdx(1)) + Int((CInt(varRegIdx(1)) / CInt(varAcesso(0))) + 1)
    intHd = ((Hour(Now) * 60) + Minute(Now))
    lngDd = CLng(Date)
    strValor = varRegIdx(0)
    strValor = strValor & "," & intTd
    strValor = strValor & "," & varRegIdx(2) & "," & varRegIdx(3)
    objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
    objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
    Call Sleep(200)
    CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave(intTd & "," & varRegIdx(2), 2) & "';"
    Call Sleep(200)
    CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & "," & intCed & "," & lngDd & "," & intHd, 2) & "';"
    If CInt(varRegIdx(1)) >= prazo Then
    fncTempoEsgotado = True
    Else
    fncTempoEsgotado = False
    End If
    Else
    If CLng(Date) = CLng(varRegIdx(2)) Then
    varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
    intHd = ((Hour(Now) * 60) + Minute(Now))
    If intHd < CInt(varAcesso(3)) Then
    strValor = varRegIdx(0)
    strValor = strValor & "," & varRegIdx(1) + 1
    strValor = strValor & "," & varRegIdx(2) & "," & varRegIdx(3)
    objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
    objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
    Call Sleep(200)
    CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave((varRegIdx(1) + 1) & "," & varRegIdx(2), 2) & "';"
    End If
    Call Sleep(200)
    CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & "," & varAcesso(1) & "," & varAcesso(2) & "," & intHd, 2) & "';"
    fncTempoEsgotado = False
    Else
    strValor = varRegIdx(0)
    strValor = strValor & "," & (varRegIdx(1) + (CLng(Date) - varRegIdx(2)))
    strValor = strValor & "," & CLng(Date) & "," & varRegIdx(3)
    Set objReg = CreateObject("wscript.shell")
    objReg.RegWrite idx, fncCripChave(strValor), "REG_SZ"
    objReg.RegWrite ida, fncCripChave(strValor, 2), "REG_SZ"
    Call Sleep(200)
    varRegIdx = Split(fncDeCripChave(objReg.RegRead(idx)), ",")
    CurrentDb.Execute "UPDATE tblRegistro SET campo3='" & fncCripChave(varRegIdx(1) & "," & varRegIdx(2), 2) & "';"
    Call Sleep(200)
    varAcesso = Split(fncDeCripChave(DLookup("campo4", "tblregistro"), 2), ",")
    CurrentDb.Execute "UPDATE tblRegistro SET campo4='" & fncCripChave(varAcesso(0) & ",0,0,0", 2) & "';"
    If CInt(varRegIdx(1)) >= prazo Then
    fncTempoEsgotado = True
    Else
    fncTempoEsgotado = False
    End If
    End If
    End If
    Set objReg = Nothing

    sair:
    Exit Function
    trataerro:
    MsgBox Err.Description & " / " & Err.Number
    fncTempoEsgotado = True
    Resume sair
    End Function




    Permanecendo com os mesmos dez dias,

    Obrigado,


    Última edição por Mylton em Dom 11 Fev 2018, 19:51, editado 2 vez(es)
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Dom 11 Fev 2018, 19:46

    Postarei o exemplo moficado.
    Sim...Tornei oculta a tabela.
    Acrescentei duas tabelas extras para certificar que a tabela registro fica oculta e as demais presentes.
    Suprimi form web e alguma coisa do código sem alterar o funcionamento.

    Procurando deixar o aplicativo entrando na internet sem conseguir validar.
    Assim torna obrigatório o registro off line.
    Penso 2 coisas:
    1) Forma de registo sem internet.
    2) Alguns, como eu não possuem aprendizado e meios de provedor.

    Obrigado.

    [Você precisa estar registrado e conectado para ver este link.]


    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Seg 12 Fev 2018, 12:37

    Mylton

    Na realidade muda-se pouca coisa nos códigos do Célula

    Primeiro:

    Veja que a chamada da função fncValidade() retorna um boolean (verdadeiro/falso. sim/não, -1,0):

    Private Sub Form_Open(Cancel As Integer)
    'If fncValidadeCom(30) = False Then
    If fncValidade(30) = False Then
    Cancel = True
    DoCmd.Quit acQuitSaveNone
    End If
    Call fncAlteraBotao
    End Sub

    Acontece que ele está ali nesse formulário, para ilustração apenas.

    Para que o código funcione, vc deve colocar essa chamada de função de preferência  numa macro autoexec que ficaria assim:

    Se fncValidade(30) = falso então

     Encerrar Access

    chamada de abertura para o formulário principal do aplicativo

    Veja que é so mudar o número de dias que está entre parenteses.


    Segundo:

    Tem ainda a chamada da função  fncAlteraBotao  que deverá ser colocada na abertura do form principal, e com base nela

    alterar conforme teu formulário.

    [ ]'s
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Seg 12 Fev 2018, 15:14

    Bom dia Noobezinho.

    Criei a Macro auto executar com

    Private Sub Form_Open(Cancel As Integer)
    'If fncValidadeCom(30) = False Then
    If fncValidade(30) = False Then
    Cancel = True
    DoCmd.Quit acQuitSaveNone
    End If
    Call fncAlteraBotao
    End Sub

    Todavia quando abre o sistema... informa:
    que não localizou Form_Open,e em consequência permanece com 10 d.

    Também deixei a fnc alterar botão no form registro mesmo.

    Anexo.

    Obrigado.
    Anexos
    Versão 2.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (68 Kb) Baixado 4 vez(es)

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Seg 12 Fev 2018, 17:26

    Mylton

    Você mexeu demais no código, até tirou a tabela principal do célula, que é a tabela onde será salvo  os dados de registro do aplicativo.

    Como disse, deixe tudo como está no célula, o que tem que fazer é utilizar uma macro Autoexec. Autoexec é o nome da macro.

    TEM que ser esse nome  para o Access iniciar por ela.

    Veja a macro.

    Criei um formulário pra ser chamado quando o registro estiver ok.

    Somente para você ver como deve ficar.

    Como você mexeu no código, está dando erro.

    Amigo, Estude o código, enquanto não entender ele, não poderá usá-lo, pois só assim, poderá distribuir uma aplicação com segurança.

    [ ]'s

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Seg 12 Fev 2018, 17:26

    Mylton

    Você mexeu demais no código, até tirou a tabela principal do célula, que é a tabela onde será salvo  os dados de registro do aplicativo.

    Como disse, deixe tudo como está no célula, o que tem que fazer é utilizar uma macro Autoexec. Autoexec é o nome da macro.

    TEM que ser esse nome  para o Access iniciar por ela.

    Veja a macro.

    Criei um formulário pra ser chamado quando o registro estiver ok.

    Somente para você ver como deve ficar.

    Como você mexeu no código, está dando erro.

    Amigo, Estude o código, enquanto não entender ele, não poderá usá-lo, pois só assim, poderá distribuir uma aplicação com segurança.

    [ ]'s
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Seg 12 Fev 2018, 18:08

    Vou baixar e verificar.
    Não exclui a tabela. Modifiquei a rotina dele para esconde-la. Coloquei a função direto no form.

    Depois coloco a versão testada.
    avatar
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 597
    Registrado : 23/08/2010

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Mylton em Seg 12 Fev 2018, 18:23

    Resolvido.
    Obrigado.

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Dúvida no aplicativo Célula.

    Mensagem  Noobezinho em Seg 12 Fev 2018, 18:58

    Ótimo Mylton


    Boa sorte!

      Data/hora atual: Qui 24 Maio 2018, 01:21