Attribute VB_Name = "Module1"
Public Const Software_Name = "Personal Diary Management"
Public Default_Font As String
Public Default_Size As Integer
Public blnDontChange As Boolean
Public lDiaryNumber As Long
Public blnFromFind As Boolean
Public Current_Diary As Date
Public blnPasswordValidated As Boolean
Public con As New Connection
Public rsTemp As New Recordset
Public strQuery As String

Sub Main()
On Error GoTo ErrHand

    Open_Connection
    
    Default_Font = GetSetting(Software_Name, "Settings", "Default_Font", "Comic Sans MS")
    Default_Size = GetSetting(Software_Name, "Settings", "Default_Size", 10)
    lDiaryNumber = 0
    
    Load frmMain
    blnDontChange = True
    frmMain.cmbFonts = Default_Font
    frmMain.cmbSize = Default_Size
    blnDontChange = False
    frmMain.Show
    
    Exit Sub
    
ErrHand:
    Error_Message "Error Occurred while Loading !!", "main"
    End
End Sub

Public Sub Error_Message(sMessage As String, sProcedure As String)
    MsgBox sMessage & _
            vbCrLf & _
            "Error : " & Err.Description & _
            vbCrLf & _
            "Error No. : " & Err.Number & _
            vbCrLf & _
            "Procedure : " & sProcedure, vbExclamation, Software_Name
End Sub

Private Sub Open_Connection()
    On Error GoTo ErrHand
        
        With con
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Data Source=" & App.Path & "\dbDiary.dat"
            .Open
        End With
        
        With rsTemp
            .ActiveConnection = con
            .LockType = adLockPessimistic
            .CursorType = adOpenStatic
        End With
        
        On Error Resume Next
    
        FileSystem.SetAttr App.Path & "\dbDiary.ldb", vbHidden
        
        Exit Sub
    
ErrHand:
    Error_Message "Error Occurred while Opening Data File !!", "Open_Connection"
    MsgBox "Software Cannot be Loaded !!", vbExclamation
    End
End Sub

Public Function XorKey(Text As String, ByVal Key As String) As String
 On Error GoTo ErrHand
 
 If IsNull(Text) = True Or IsEmpty(Text) = True Then
    XorKey = ""
 Else
 
    Dim i As Long, TextLen As Long
    Dim KeyLen As Long
    Const Mask16 As Long = &HFFFF
    Dim vKey() As Long
    
    TextLen = Len(Text)
    KeyLen = Len(Key)
    
    If TextLen > 0 Then
        ReDim vKey(KeyLen - 1)
        For i = 0 To KeyLen - 1
            vKey(i) = AscW(Mid$(Key, i + 1, 1))
        Next i
        XorKey = String$(TextLen, Chr$(0))
        For i = 1 To TextLen
            Mid$(XorKey, i, 1) = ChrW$(Mask16 And (AscW(Mid$(Text, i, 1)) Xor vKey(i Mod KeyLen)))
        Next i
    End If
End If

    Exit Function
ErrHand:
    Error_Message "Error Occurred while Encrypting/Decrypting Password !!", "XorKey"
    
End Function
