Public UsuarioSessao As String

Public Type UserHeader
Username As String * 32
Password As String * 64
End Type

Public Type LoginStruct
 Count As Long          '4 bytes
 Users() As UserHeader  'cada item vai ter 96 bytes
End Type

Public Const LoginFileName = "C:\Users\ATHLONX264\Documents\SISCEV\sistema.dat" 'Altere isso antes de testar. É aonde será gravado o arquivo de login.
Public Sub CriaArquivo()
'Use isso antes de testar o programa.
'Este procedimento cria o arquivo de login

Dim BlankLoginFile As LoginStruct
Open LoginFileName For Binary As #1
Put #1, , BlankLoginFile
Close #1
End Sub
Public Sub Cadastra(ByVal Nome As String, ByVal Senha As String)
'Este procedimento cadastra um usuário.
'Codifique a senha antes de passar o argumento Senha.

Dim ExistingLoginFile As LoginStruct
Open LoginFileName For Binary As #1
Get #1, , ExistingLoginFile
Close #1

ReDim Preserve ExistingLoginFile.Users(ExistingLoginFile.Count)

ExistingLoginFile.Users(ExistingLoginFile.Count).Username = Nome
ExistingLoginFile.Users(ExistingLoginFile.Count).Password = Senha
ExistingLoginFile.Count = ExistingLoginFile.Count + 1

Open LoginFileName For Output As #1
Close #1 'Isto apaga o arquivo para poder reescrever

Open LoginFileName For Binary As #1
Put #1, , ExistingLoginFile
Close #1
End Sub
Function Codifica(ByVal Senha As String) As String
'Esta função codifica de forma básica.
'Exemplo: "teste" vira "futfu"

Dim Resultado As String
    For i = 1 To Len(Senha)
    Resultado = Resultado & Chr(Asc(Mid(Senha, i, 1)) + 1)
    Next i
Resultado = StrReverse(Resultado)
Codifica = Resultado
End Function
Sub RemoverUsuário(Nome As String)
'Este procedimento remove um usuário pelo seu login.

Dim ExistingLoginFile As LoginStruct
Dim NewLoginFile As LoginStruct

Open LoginFileName For Binary As #1
Get #1, , ExistingLoginFile
Close #1

    If ExistingLoginFile.Count > 1 Then
    NewLoginFile.Count = ExistingLoginFile.Count - 1
    Dim j As Long
    j = 0
        For i = 0 To ExistingLoginFile.Count - 1
            If ExistingLoginFile.Users(i).Username <> Nome Then
            NewLoginFile.Users(j).Username = ExistingLoginFile.Users(i).Username
            NewLoginFile.Users(j).Password = ExistingLoginFile.Users(i).Password
            j = j + 1
            End If
        Next
    End If

Open LoginFileName For Output As #1
Close #1 'Isto apaga o arquivo para poder reescrever

Open LoginFileName For Binary As #1
Put #1, , NewLoginFile
Close #1
End Sub
Function VerificaSenha(ByVal Nome As String, ByVal Senha As String) As Boolean
'Este procedimento verifica login. True se a senha é correta, e false se não é.
'Codifique a senha antes de passar o argumento Senha.

Dim ExistingLoginFile As LoginStruct
Open LoginFileName For Binary As #1
Get #1, , ExistingLoginFile
Close #1

  For i = 0 To ExistingLoginFile.Count - 1
     If Nome = Trim(ExistingLoginFile.Users(i).Username) Then
         If Senha = Trim(ExistingLoginFile.Users(i).Password) Then
         VerificaSenha = True
         Else
         VerificaSenha = False
         End If
     Exit Function
     End If
  Next
End Function