Option Explicit
Public LoginSucceeded As Boolean
Private Sub cmdCancel_Click()
'set the global var to false
'to denote a failed login
LoginSucceeded = False
End
End Sub
[COLOR="Red"][SIZE="3"]* na rotina abaixo, deixo uma pass de reserva (a vermelho). Como nem sempre sou eu a usar o soft, se alguém criar uma nova password de acesso, e se esquecer da mesma, eu posso sempre entrar com esta. Trata-se de uma pass vitalícia.[/SIZE][/COLOR]
Private Sub cmdOK_Click()
On Error Resume Next
'check for correct password
If RTrim(LTrim(txtPassword)) = "[COLOR="Red"]pass_de_reserva[/COLOR]" Or existe_pass(RTrim(LTrim(txtPassword))) Then
'place code to here to pass the
'success to the calling sub
'setting a global var is the easiest
LoginSucceeded = True
Data2.Refresh
If Data2.Recordset.RecordCount > 0 Then
Data2.Recordset.MoveFirst
caminho = RTrim(LTrim(Data2.Recordset.Fields("acesso_ficheiros").Value))
empresa = RTrim(LTrim(Data2.Recordset.Fields("empresa").Value))
morada_empresa = RTrim(LTrim(Data2.Recordset.Fields("morada_empresa").Value))
localidade_empresa = RTrim(LTrim(Data2.Recordset.Fields("localidade_empresa").Value))
contribuinte_empresa = RTrim(LTrim(Data2.Recordset.Fields("contribuinte_empresa").Value))
Else
MsgBox ("POR FAVOR, CONFIGURE OS DADOS DA EMPRESA")
End If
Call Pesquisa_actualiza
PRINCIPAL.Show
Unload Me
Else
MsgBox "PASSORD INVÁLIDA, TENTE NOVAMENTE!", , "Login"
txtPassword.SetFocus
SendKeys "{Home}+{End}"
End If
End Sub
[SIZE="3"][COLOR="Red"]* de notar que os dados da pass, vou buscá-los a uma base de dados em access, no computador local[/COLOR][/SIZE]
Private Function existe_pass(val As String) As Boolean
Dim encontra As Boolean
Dim teste_acesso As String
Dim teste_encontra As String
On Error Resume Next
Data1.Refresh
Data1.Recordset.MoveFirst
teste_acesso = RTrim(LTrim(Data1.Recordset.Fields("password").Value))
encontra = False
existe_pass = False
Do While (Not encontra) And (Not Data1.Recordset.EOF)
If RTrim(LTrim(Data1.Recordset.Fields("password").Value)) = val Then
encontra = True
existe_pass = True
teste_encontra = RTrim(LTrim(Data1.Recordset.Fields("password").Value))
Else
Data1.Recordset.MoveNext
End If
Loop
If teste_encontra = teste_acesso Or RTrim(LTrim(txtPassword)) = "EMIDIOMANUELBRAGA" Then
acesso_geral = True
Else
acesso_geral = False
End If
End Function
Private Sub Form_Activate()
Call Main
End Sub
Private Sub Form_Load()
Dim teste1 As String, teste2 As String, teste3 As String
SaveSetting "MyApp", "Settings", "local", App.Path & "\"
Rem Inicilalização dos valores impressão cod. barras
teste1 = GetSetting("MyApp", "Settings", "barra1", "")
teste2 = GetSetting("MyApp", "Settings", "barra2", "")
teste3 = GetSetting("MyApp", "Settings", "barra3", "")
If IsNumeric(teste1) Then
If IsNumeric(teste2) Then
If IsNumeric(teste3) Then
barra1 = teste1
barra2 = teste2
barra3 = teste3
Else
barra1 = 2780
barra2 = 3730
barra3 = 3960
End If
Else
barra1 = 2780
barra2 = 3730
barra3 = 3960
End If
Else
barra1 = 2780
barra2 = 3730
barra3 = 3960
End If
Rem fim codigo de barras
[COLOR="Red"][SIZE="3"]* como uso, no soft principal, artigos com impressão de códigos de barras, aqui vou buscar esses dados ao computador e carregá-los em memória.
[/SIZE][/COLOR]
caminho = App.Path & "\"
Data1.DatabaseName = caminho & "database\gespos.mdb"
Data2.DatabaseName = caminho & "database\gespos.mdb"
End Sub
Private Sub txtPassword_LostFocus()
txtPassword = UCase(txtPassword)
End Sub
[COLOR="Red"][SIZE="3"]*como o meu soft está em vários pontos distantes, quando faço uma actualização para ele, coloco essa actualização na net. posteriormente quando o soft se inicia vai sempre á net verificar se existe alguma acualização para o mesmo. se houver, faz download e actualiza-se.[/SIZE][/COLOR]
Private Sub Pesquisa_actualiza()
Dim i As Integer, loca As String
Dim datCreated As String, actualiza_date As String
Dim d1 As Date, d2 As Date
Dim objFSO As Object
Dim objFSO_GetFile As Object
loca = GetSetting("MyApp", "Settings", "local", "")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO_GetFile = objFSO.GetFile(loca & "playdiune.exe")
datCreated = objFSO_GetFile.DateCreated
Set objFSO_GetFile = objFSO.GetFile("c:\windows\playdiune\update\playdiune.exe")
actualiza_date = objFSO_GetFile.DateCreated
If Dir("c:\windows\playdiune\update\playdiune.exe", vbArchive) = "" Then
Else
i = MsgBox("Foi detectada uma Actualização do Software. Pretende actualizar agora ?", vbOKCancel, "PLAYDIUNE - ACTUALIZAÇÃO AUTOMÁTICA")
If i = vbOK Then
Rem COMPARAÇÃO DAS DATAS DE CRIAÇÃO
loca = GetSetting("MyApp", "Settings", "local", "")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO_GetFile = objFSO.GetFile(loca & "playdiune.exe")
datCreated = objFSO_GetFile.DateCreated
d1 = Mid(datCreated, 1, 10)
Set objFSO_GetFile = objFSO.GetFile("c:\windows\playdiune\update\playdiune.exe")
actualiza_date = objFSO_GetFile.DateCreated
d2 = Mid(actualiza_date, 1, 10)
If d1 > d2 Then
MsgBox "OPERAÇÃO CANCELADA ! " & vbCrLf & "" & vbCrLf & "A versão que pretende instalar é mais antiga que a que está actualmente instalada !", vbCritical, "PLAYDIUNE - ACTUALIZAÇÃO AUTOMÁTICA"
Kill "c:\windows\playdiune\update\playdiune.exe"
Exit Sub
End If
Set objFSO_GetFile = Nothing
Set objFSO = Nothing
Rem FIM DA COMPARAÇÃO
If Dir("c:\windows\playdiune\update\actualiza.exe", vbArchive) = "" Then
MsgBox "Rotina de Actualização não encontrada !", vbCritical
Else
Shell "c:\windows\playdiune\update\actualiza.exe", vbNormalFocus
End
End If
End If
End If
End Sub
