Keskustelu: Ohjelmointikysymykset: VB6: Muutos, ettei kaikki muut katoaisi?

Option Explicit
  'Esittelyn jälkeen ObjFso voidaan panna viittaamaan
  'FileSystemObject- tyyppiä olevaan muutujaan.
  Dim ObjFso As scripting.FileSystemObject

  'Esitellään muuttuja ObjTextStream, joka on tyyppiä TextSream
   Dim ObjTextStream As scripting.TextStream
   'Esitellään objektimuuttuja ObjFso(=File system object)
   Dim rivi As String

Private Sub cmdSelaa_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        Dim rivi As String
        Dim taulu() As String
        Dim tiedot As String
        Dim i As Integer

        'luetaan käyttäjätunnus ja salasana muuttujaan rivi
        rivi = "txtKäyttäjä;txtSalasana"

            For i = 0 To ObjTextStream.AtEndOfStream

                rivi = ObjTextStream.ReadLine
'Splip funktio jakaa merkkijonon taulukkoon ;- merkin kohdalta
                taulu = Split(rivi, ";")
                txtKäyttäjä = taulu(0)
                txtSalasana = taulu(1)
                i = i + 1
             Next
        'Jos kyseessä on viimeinen tietue, niin ohjelma lähettää
        'ilmoituksen siitä
            If ObjTextStream.AtEndOfStream Then
                MsgBox "Se oli viimeinen tietue. Sulje selain lomakkeen yläkulmasta"
            End If
End Sub

Private Sub cmdTalleta_Click()
  Dim strrivi As String
  Set ObjTextStream = ObjFso.OpenTextFile("C:\Testi\Tunnukset.txt", ForWriting)
   'Annetaan strRivi muuttujalle arvoksi merkkijono, joka saadaan
  'yhdistämällä käyttäjätunnus, ; ja salasana
   strrivi = txtKäyttäjä & ";" & txtSalasana

   ObjTextStream.WriteLine strrivi

   ObjTextStream.Close
   MsgBox "Muutos tallennettu tiedostoon. Sulje selain lomakkeen yläkulmasta"

End Sub


Private Sub Form_Load()
   Set ObjFso = CreateObject("scripting.FileSystemObject")
   Set ObjTextStream = ObjFso.OpenTextFile("C:\Testi\Tunnukset.txt", 1)

End Sub

Option Explicit
Public oDict As New Dictionary
Private mvarDelimiter As String
Private mvarFilePath As String
Private mvarErrNumber As Long
Private mvarErrDescription As String
Private mvarErrSource As String
Public Property Let ErrSource(ByVal vData As String)
    mvarErrSource = vData
End Property

Public Property Get ErrSource() As String
    ErrSource = mvarErrSource
End Property

Public Property Let ErrDescription(ByVal vData As String)
    mvarErrDescription = vData
End Property

Public Property Get ErrDescription() As String
    ErrDescription = mvarErrDescription
End Property

Public Property Let ErrNumber(ByVal vData As Long)
    mvarErrNumber = vData
End Property

Public Property Get ErrNumber() As Long
    ErrNumber = mvarErrNumber
End Property

Public Property Let FilePath(ByVal vData As String)
    mvarFilePath = vData
End Property

Public Property Get FilePath() As String
    FilePath = mvarFilePath
End Property

Public Property Let Delimiter(ByVal vData As String)
    mvarDelimiter = vData
End Property

Public Property Get Delimiter() As String
    Delimiter = mvarDelimiter
End Property

Public Function ReadFile() As Boolean
    Dim objFile As New FileSystemObject
    Dim tsTextIn As TextStream
    Dim strFileData() As String
On Error GoTo errhandler
    If objFile.FileExists(FilePath) Then
        Set tsTextIn = objFile.OpenTextFile(mvarFilePath, ForReading, False)
        Do While Not tsTextIn.AtEndOfStream
            strFileData = Split(tsTextIn.ReadLine, mvarDelimiter)
            oDict.Add strFileData(0), strFileData(1)
        Loop
        tsTextIn.Close
       ReadFile = True
    Else
        Err.Raise -1, "ReadFile", "Tiedostoa ei löytynyt"
    End If
Exit Function
errhandler:
    ReadFile = False
    HandleErrors Err
End Function

Public Function WriteFile() As Boolean
    Dim objFile As New FileSystemObject
    Dim tsTextOut As TextStream
    Dim strFileData As String
    Dim key As Variant
On Error GoTo errhandler
    Set tsTextOut = objFile.OpenTextFile(mvarFilePath, ForWriting, True)
    For Each key In oDict.Keys
       tsTextOut.WriteLine key & mvarDelimiter & oDict(key)
    Next
    tsTextOut.Close
Exit Function
errhandler:
    WriteFile = False
    HandleErrors Err
End Function

Public Function CheckPassword(strUserName As String, strPassword As String) As Boolean
On Error GoTo errhandler
    If Trim(strUserName) = "" Or Trim(strPassword) = "" Then Err.Raise -3, "CheckPassword", "Tyhjä parametri"
    If oDict.Exists(strUserName) Then
        If oDict(strUserName) = strPassword Then
            CheckPassword = True
        Else
            CheckPassword = False
        End If
    Else
        CheckPassword = False
    End If
Exit Function
errhandler:
    CheckPassword = False
    HandleErrors Err
End Function

Public Function ChangeUserData(strOldUserName As String, strNewUserName As String, strPassword As String, Optional bSaveToFile As Boolean = True) As Boolean
On Error GoTo errhandler
    If Trim(strNewUserName) = "" Or Trim(strNewUserName) = "" Or Trim(strPassword) = "" Then Err.Raise -3, "ChangeUserData", "Tyhjä parametri"
    If oDict.Exists(strOldUserName) Then
        If strOldUserName <> strNewUserName Then
            oDict.Add strNewUserName, strPassword
            oDict.Remove strOldUserName
        Else
            oDict(strOldUserName) = strPassword
        End If
        If bSaveToFile Then WriteFile
        ChangeUserData = True
    Else
        Err.Raise -2, "ChangeUserData", "Muutettavaa käyttäjätunnusta ei löydy:" & strOldUserName
    End If
Exit Function
errhandler:
    ChangeUserData = False
    HandleErrors Err
End Function

Public Function AddUserData(strUserName As String, strPassword As String, Optional bSaveToFile As Boolean = True) As Boolean
On Error GoTo errhandler
    If Trim(strUserName) = "" Or Trim(strPassword) = "" Then Err.Raise -3, "AddUserData", "Tyhjä parametri"
    If Not oDict.Exists(strUserName) Then
        oDict.Add strUserName, strPassword
        If bSaveToFile Then WriteFile
        AddUserData = True
    Else
        Err.Raise -2, "AddUserData", "Käyttäjätunnus on jo varattu:" & strUserName
    End If
Exit Function
errhandler:
    AddUserData = False
    HandleErrors Err
End Function

Public Function DeleteUserData(strUserName As String, Optional bSaveToFile As Boolean = True) As Boolean
On Error GoTo errhandler
    If Trim(strUserName) = "" Then Err.Raise -3, "DeleteUserData", "Tyhjä parametri"
    If Not oDict.Exists(strUserName) Then
        oDict.Remove strUserName
        If bSaveToFile Then WriteFile
        DeleteUserData = True
    Else
        Err.Raise -2, "DeleteUserData", "Käyttäjätunnus ei löydy" & strUserName
    End If
Exit Function
errhandler:
    DeleteUserData = False
    HandleErrors Err
End Function

Private Function HandleErrors(oErr As ErrObject)
    Dim oErrFile As New FileSystemObject
    Dim tsErrors As TextStream
    Me.ErrNumber = oErr.Number
    Me.ErrDescription = oErr.Description
    Me.ErrSource = oErr.Source
    Set tsErrors = oErrFile.OpenTextFile(App.Path & "\ErrLog.txt", ForWriting, True)
    tsErrors.WriteLine Now() & " : " & oErr.Number & " : " & oErr.Source & " : " & oErr.Description
    tsErrors.Close
End Function

Dim pwd As New Password
Private Sub Form_Load()
    Set pwd = New Password
    pwd.Delimiter = ";"
    pwd.FilePath = App.Path & "\PwdFile.dat"
    If Not pwd.ReadFile Then
        MsgBox "Virhe ladattaessa salasanoja"
    End If
End Sub
Private Sub cmdManage_Click(Index As Integer)
    Select Case Index
    Case 0
        If Not pwd.AddUserData(txtUserName.Text, txtPassword.Text) Then
            MsgBox "Virhe lisättäessä salasanaa:" & pwd.ErrDescription
        End If
    Case 1
        If Not pwd.DeleteUserData(txtUserName.Text) Then
            MsgBox "Virhe poistettaessa salasanaa: " & pwd.ErrDescription
        End If
    Case 2
        If Not pwd.ChangeUserData(txtUserName.Text, txtNewUserName.Text, txtPassword.Text) Then
            MsgBox "Virhe muokattaessa salasanaa: " & pwd.ErrDescription
        End If
    Case 3
        pwd.WriteFile
    Case 4
        If Not pwd.CheckPassword(txtUserName.Text, txtPassword.Text) Then
            MsgBox "Väärä käyttäjätunnus tai salasana"
        Else
            MsgBox "Oikea salasana"
        End If
    End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
    pwd.WriteFile
End Sub