Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Textbox procurarando valor errado no arquivo TXT

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Avatar do usuário
willianrc
Colaborador
Colaborador
Mensagens: 40
Registrado em: Qua Nov 23, 2016 7:28 am

Textbox procurarando valor errado no arquivo TXT

Mensagem por willianrc »

Ola galerinha,
Estou tentando fazer uma telinha de login , porem o TEXTBOX esta procurando o valor aleatorio no arquivo TXT todo , nao linha-a-linha o exato valor que eu quero para o login. E quando encontrasse o LOGIN e SENHA ja carregasse a TxtLevel do usuario para fazer o direcionamento de tela. Alguem me da uma ajuda?
Segue o anexo.

Código: Selecionar todos

Option Explicit

Private Sub UserForm_Initialize()
    frmLogin.Width = 580
    Call Check_UsersTXT
    ComboBox1.AddItem "ADMINISTRATOR"
    ComboBox1.AddItem "MANAGER"
    ComboBox1.AddItem "OPERATOR"

End Sub

Private Sub Label19_Click() 'Label REGISTER

    Frame1.Left = 588
    Frame2.Left = 6  'Frame2 in evidence for register
    BtnBack.Visible = True 'Makes the button BACK visible
    BtnForgotPass.Visible = False 'Make the button FORGET PASSWORD invisible
    Call Add_Counter 'ADD COUNTER
End Sub

Private Sub BtnBack_Click() 'Button BACK

    Frame1.Left = 6 'Frame1 in evidence for login
    Frame2.Left = 588
    Frame3.Left = 1158
    BtnBack.Visible = False ''Make the button BACK invisible
    BtnForgotPass.Visible = True 'Make the button FORGET PASSWORD visible
End Sub

Private Sub BtnForgotPass_Click() 'Button Forgot Password
    Frame1.Left = 1158
    Frame3.Left = 6 'Frame2 in evidence for register
    BtnBack.Visible = True ''Make the button BACK visible
    BtnForgotPass.Visible = False 'Make the button FORGET PASSWORD invisible
End Sub

Private Sub TxtLogin_Change() 'MAKE SURE LOGIN IS VALID

    Call SearchStringFileTXT

End Sub
Private Sub TxtLogin_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'MAKE SURE LOGIN IS VALID

    Call SearchStringFileTXT

End Sub

Private Sub TxtPassword_Change() 'MAKE SURE PASSWORD IS VALID

    Call SearchPASSWORDFileTXT

End Sub

Private Sub TxtPassword_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'MAKE SURE PASSWORD IS VALID

    Call SearchPASSWORDFileTXT

End Sub

Private Sub TxtCadConfPass_Change() 'MAKE SURE PASSWORD IS THE SAME

    If TxtCadConfPass.Text <> TxtCadPass.Text Then
      Me.Label23 = "O"
      Me.Label23.ForeColor = &HFF&    'red
      Me.Label24 = "O"
      Me.Label24.ForeColor = &HFF&    'red
        If TxtCadConfPass.Text = "" Or TxtCadPass.Text = "" Then
            Me.Label23 = "O"
            Me.Label23.ForeColor = &HFF&    'red
            Me.Label24 = "O"
            Me.Label24.ForeColor = &HFF&    'red
        Else
        End If
    Else
      Me.Label23 = "O"
      Me.Label23.ForeColor = &HFF00& 'green
      Me.Label24 = "O"
      Me.Label24.ForeColor = &HFF00& 'green
    End If

End Sub

Private Sub TxtCadConfPass_(ByVal Cancel As MSForms.ReturnBoolean) 'MAKE SURE PASSWORD IS THE SAME

    If TxtCadConfPass.Text <> TxtCadPass.Text Then
      Me.Label23 = "O"
      Me.Label23.ForeColor = &HFF&    'red
      Me.Label24 = "O"
      Me.Label24.ForeColor = &HFF&    'red
        If TxtCadConfPass.Text = "" Or TxtCadPass.Text = "" Then
            Me.Label23 = "O"
            Me.Label23.ForeColor = &HFF&    'red
            Me.Label24 = "O"
            Me.Label24.ForeColor = &HFF&    'red
        Else
        End If
    Else
      Me.Label23 = "O"
      Me.Label23.ForeColor = &HFF00& 'green
      Me.Label24 = "O"
      Me.Label24.ForeColor = &HFF00& 'green
    End If

End Sub

Private Sub SearchStringFileTXT() 'SEARCH LOGIN IN USERS.TXT
    
   Dim strFileName As String
   strFileName = ThisWorkbook.Path & "\REGISTER\users.txt"
    Dim strSearch As String
    strSearch = TxtLogin.Text
    Dim strLine As String
    Dim f As Integer
    Dim lngLine As Long
    Dim blnFound As Boolean
    f = FreeFile
    
        Open strFileName For Input As #f
        Do While Not EOF(f)
            lngLine = lngLine + 1
            Line Input #f, strLine
            If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
                'MsgBox "Search string found in line " & lngLine, vbInformation
                Me.Label1 = "O"
                Me.Label1.ForeColor = &HFF00& 'green
                blnFound = True
                Exit Do
            End If
        Loop
        Close #f
        If Not blnFound Then
            'MsgBox "Search string not found", vbInformation
            Me.Label1 = "O"
            Me.Label1.ForeColor = &HFF&    'red
        End If
    
End Sub

Private Sub SearchPASSWORDFileTXT() 'SEARCH PASSWORD IN USERS.TXT
    
   Dim strFileName As String
   strFileName = ThisWorkbook.Path & "\REGISTER\users.txt"
    Dim strSearch As String
    strSearch = TxtPassword.Text
    Dim strLine As String
    Dim f As Integer
    Dim lngLine As Long
    Dim blnFound As Boolean
    f = FreeFile
    
        Open strFileName For Input As #f
        Do While Not EOF(f)
            lngLine = lngLine + 1
            Line Input #f, strLine
            If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
                'MsgBox "Search string found in line " & lngLine, vbInformation
                Me.Label2 = "O"
                Me.Label2.ForeColor = &HFF00& 'green
                blnFound = True
                Exit Do
            End If
        Loop
        Close #f
        If Not blnFound Then
            'MsgBox "Search string not found", vbInformation
            Me.Label2 = "O"
            Me.Label2.ForeColor = &HFF&    'red
        End If
    
End Sub


Private Sub BtnGo_Click()

    If Me.Label1.ForeColor = &HFF& Or Me.Label2.ForeColor = &HFF& Or Me.Label1.ForeColor = &HFFFFFF Or Me.Label2.ForeColor = &HFFFFFF Then
           lblMsg = "SOMETHING WRONG OR USER BLOCKED"
           Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
        Else
           BtnGo.Caption = "LOADING..."
           BtnGo.BackColor = &H404040    'grey
           Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
    End If
    lblMsg = ""
    
End Sub

Private Sub TxtCadDateBirth_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'TEXTBOX FOR DATE

    TxtCadDateBirth.MaxLength = 10 '10/10/2017
     Select Case KeyAscii
          Case 8       'Accept o BACK SPACE
          Case 13: SendKeys "{TAB}"    'Emula o TAB
          Case 48 To 57
             If TxtCadDateBirth.SelStart = 2 Then TxtCadDateBirth.SelText = "/"
             If TxtCadDateBirth.SelStart = 5 Then TxtCadDateBirth.SelText = "/"
          Case Else: KeyAscii = 0     'Ignore others caracters
       End Select
              
End Sub

Private Sub Check_UsersTXT()  'CHECK FILE USERS

Dim strPath As Variant
Dim strCheck As String
    'CHECK FOLDERS AND FILES
strPath = ThisWorkbook.Path & "\REGISTER\users.txt"
    If Dir(strPath) = vbNullString Then
        strCheck = False
            Call Create_UserTXT 'if the file NO exist do it.
    Else
        strCheck = True
                               'if the file exist do it. Nothing
    End If
End Sub

Private Sub Create_UserTXT()    'CREATE FILE USER

   Dim f As Integer
   f = FreeFile
    If Len(Dir(ThisWorkbook.Path & "\REGISTER", vbDirectory)) = 0 Then
        MkDir ThisWorkbook.Path & "\REGISTER"
        Open ThisWorkbook.Path & "\REGISTER\users.txt" For Output As #f
        Close #f
        'Open ThisWorkbook.Path & "\REGISTER\companies.txt" For Output As #f
        'Close #f
        'Open ThisWorkbook.Path & "\REGISTER\machines.txt" For Output As #f
        'Close #f
        'Open ThisWorkbook.Path & "\REGISTER\configurations.txt" For Output As #f
        'Close #f
        MsgBox "PERFECT"
    End If

End Sub

Private Sub BtnSend_Click() ' BUTTON REGISTER NEW USERS

    If TxtCadLogin = "" Or TxtCadName = "" Or TxtCadDateBirth = "" Or TxtCadPass = "" Or TxtCadConfPass = "" Or CheckBox1.Value = False Or ComboBox1.Value = "" Then
        Label29.Caption = "ENTER ALL REQUIRED FIELDS AND CHECKBOX."
        Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
        Label29.Caption = ""
    Else
        Call Add_Counter 'ADD COUNTER
        SaveInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TxtIdCompany.Text) & "|" & VBA.Trim(TxtCadLogin.Text) & "|" & VBA.Trim(TxtCadName.Text) & "|" & VBA.Trim(TxtCadDateBirth.Text) & "|" & VBA.Trim(TxtCadPass.Text) & "|" & VBA.Trim(TxtCadConfPass.Text) & "|" & VBA.Trim(ComboBox1.Text)
        Call ClearFields
        Label29.Caption = "NOW, YOU NEED TO WAIT FOR THE ADMINISTRATOR RELEASE."
        Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
        Frame1.Left = 6 'Frame1  in evidence for login
        Frame2.Left = 588
        Frame3.Left = 1158
        BtnBack.Visible = False 'Make the button BACK invisible
        BtnForgotPass.Visible = True 'Make the button FORGET PASSWORD visible
        Label29.Caption = ""
    End If
End Sub


Private Sub SaveInfo(LogMessage As String) 'SAVE DATA

Dim LogFileName As String
Dim CheckFolder As String
Dim FileNum As Integer

    CheckFolder = ThisWorkbook.Path & "\REGISTER"  'Set Path
    LogFileName = CheckFolder & "\users.txt"   'Set file name
    
    If Dir(LogFileName, vbNormal) <> "" Then                                'If the file does not
        If FileLen(LogFileName) Then LogMessage = vbNewLine & LogMessage    'exist, the same file is
    End If                                                                  'created
    FileNum = FreeFile
    Open LogFileName For Append As #FileNum
        Print #FileNum, LogMessage;
    Close #FileNum
    UserForm_Initialize
End Sub

Private Sub ClearFields() 'Clear Fields NEW USERS

    TextBox1.Text = ""
    TxtIdCompany = ""
    TxtCadLogin = ""
    TxtCadName = ""
    TxtCadDateBirth = ""
    TxtCadPass = ""
    TxtCadConfPass = ""
    CheckBox1.Value = False
    Label23.Caption = ""
    Label24.Caption = ""
    ComboBox1 = ""
End Sub

Private Sub Add_Counter() 'ADD COUNTER

Call Check_UsersTXT
    Dim FileName As String
    Dim FileNum As Integer
    Dim Arr() As Variant
    Dim r As Long
    Dim data As String
''   *** Change path and file name to suit ***
    FileName = ThisWorkbook.Path & "\REGISTER\users.txt"
    FileNum = FreeFile
    r = 1
    Open FileName For Input As #FileNum
    Do While Not EOF(FileNum)
        Line Input #FileNum, data
        ReDim Preserve Arr(1 To r)
        Arr(r) = data
        r = r + 1
    Loop
    Close #FileNum
    If FileLen(FileName) <> 0 Then           'TEST IF BLANK TXT FILE
        TextBox1.Text = Split(Arr(UBound(Arr)), "|")(0) + 1
        Else
        TextBox1.Text = 1
   End If
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Textbox procurarando valor errado no arquivo TXT

Mensagem por Reinaldo »

CrossPost http://www.planilhando.com.br/forum/vie ... db4a446a64
Como disse em outro tópico utilizar txt e possível, mas requer mais esforço para obter o que se espera.
Voce esqueceu de dizer qual a composição da string existente no txt users e qual "campo" deve ser conferido e retornar o que, onde e quando.
Sua rotina "SearchStringFileTXT" e disparada a cada modificação (entenda digitação tambem) efetuada no campo TxtLogin, assim se na primeira digitação o caracter informado for encontrado em alguma linha do txt irá validar sua rotina.
Creio que deva retirar os eventos TxtLogin_Change() e TxtPassword_Change()


Avatar do usuário
willianrc
Colaborador
Colaborador
Mensagens: 40
Registrado em: Qua Nov 23, 2016 7:28 am

Re: Textbox procurarando valor errado no arquivo TXT

Mensagem por willianrc »

TxtLogin tera q pesquisar sempre na terceira coluna ,
exemplo :
1|FA123|FX4455|JHON|22/02/2002|123|123|OPERATOR
2|FA222|XYZ|JHONIE|14/07/2007|441|441|MANAGER

Tera q pesquisar por FX4455 ( nesta coluna )

apos o usuario digitar o Login tera que acerta o Password, TxtPassword tera que pesquisar a sexta coluna (123)

quando Login e Senha estiver OK , automaticamente carregar no TxtLevel atraves da coluna 8.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Textbox procurarando valor errado no arquivo TXT

Mensagem por Reinaldo »

Segue uma possibilidade
Obs.: Efetuei a leitura/comparação somente para o TxtLogin, se atender utilize o mesmo raciocínio para as demais
Anexos
Login.zip
(76.08 KiB) Baixado 343 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
willianrc
Colaborador
Colaborador
Mensagens: 40
Registrado em: Qua Nov 23, 2016 7:28 am

Re: Textbox procurarando valor errado no arquivo TXT

Mensagem por willianrc »

Tenho uma pergunta, porque está retornando esses valores(" ========= ") no TxtLevel ?


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Textbox procurarando valor errado no arquivo TXT

Mensagem por Reinaldo »

Pela configuração desse campo em seu projeto.
No Editor VBE, Selecione o TxtLevel, vá na janela Propriedades e procure por PasswordChar; está "="
Se quiser ver o valor deixe sem nada


Avatar do usuário
willianrc
Colaborador
Colaborador
Mensagens: 40
Registrado em: Qua Nov 23, 2016 7:28 am

Re: Textbox procurarando valor errado no arquivo TXT

Mensagem por willianrc »

perfeito, muito obrigado.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder