Attribute VB_Name = "modMain"
'=========================================
'=          Easy Emailer 2.4             =
'=---------------------------------------=
'=  Developed by P. G. B. Prasanna       =
'=  A Software Developer from Sri Lanka  =
'=  E-mail: pgbsoft@gmail.com            =
'=---------------------------------------=
'=        Copyright © 2015 PGBSoft       =
'=           All rights reserved         =
'=========================================

'Main module for Easy Emailer.

Option Explicit

Public Declare Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Const LB_SETHORIZONTALEXTENT = &H194

Private Const LB_GETITEMRECT = &H198

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Function SetWindowPos _
    Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As WndInsertAfterEnum, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As SetWindowPosFlagsEnum) As Long

Private Enum WndInsertAfterEnum
    HWND_BOTTOM = 1
    HWND_BROADCAST = &HFFFF&
    HWND_DESKTOP = 0
    HWND_NOTOPMOST = -2
    HWND_TOP = 0
    HWND_TOPMOST = -1
End Enum

Private Enum SetWindowPosFlagsEnum
    SWP_FRAMECHANGED = &H20
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    SWP_HIDEWINDOW = &H80
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200
    SWP_NOREDRAW = &H8
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_SHOWWINDOW = &H40
End Enum

Private Declare Function InternetGetConnectedStateEx _
    Lib "wininet.dll" Alias "InternetGetConnectedStateExA" _
    (ByRef lpdwFlags As Long, _
    ByVal lpszConnectionName As String, _
    ByVal dwNameLen As Long, _
    ByVal dwReserved As Long) As Long

Private Declare Function ReleaseCapture _
    Lib "user32" () As Long

'Private Declare Function FindWindow _
'    Lib "user32" Alias "FindWindowA" _
'    (ByVal lpClassName As String, _
'    ByVal lpWindowName As String) As Long

'Private Declare Function GetProcAddress _
'      Lib "kernel32" _
'      (ByVal hModule As Long, _
'       ByVal lpProcName As String) _
'      As Long

Public Declare Sub Sleep _
    Lib "kernel32" _
    (ByVal dwMilliseconds As Long)
  
Private Declare Function CreateMutex _
    Lib "kernel32" Alias "CreateMutexA" _
    (lpMutexAttributes As Any, _
    ByVal bInitialOwner As Long, _
    ByVal lpName As String) As Long
    
Private Declare Function ReleaseMutex _
    Lib "kernel32" (ByVal hMutex As Long) As Long
    
Private Declare Function CloseHandle _
    Lib "kernel32" (ByVal hObject As Long) As Long

Private Const ERROR_ALREADY_EXISTS As Long = 183&

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Private Declare Function GetSystemMenu _
    Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal bRevert As Long) As Long

Private Declare Function GetMenuItemInfo _
    Lib "user32" Alias "GetMenuItemInfoA" _
    (ByVal hMenu As Long, _
    ByVal un As Long, _
    ByVal b As Boolean, _
    lpMenuItemInfo As MENUITEMINFO) As Long

Private Declare Function SetMenuItemInfo _
    Lib "user32" Alias "SetMenuItemInfoA" _
    (ByVal hMenu As Long, _
    ByVal un As Long, _
    ByVal bool As Boolean, _
    lpcMenuItemInfo As MENUITEMINFO) As Long

Private Declare Function IsWindow _
    Lib "user32" _
    (ByVal hwnd As Long) As Long

Private Const SC_CLOSE As Long = &HF060&
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86

Private Declare Function InitCommonControlsEx _
    Lib "comctl32.dll" _
        (iccex As tagInitCommonControlsEx) As Boolean
    
Private Const ICC_USEREX_CLASSES = &H200
Private Type tagInitCommonControlsEx
    lngSize As Long: lngICC As Long
End Type

Public blnProceed As Boolean
Public blnSndAccess As Boolean
Public intDeleteAll As Integer
Public intContactEditMode As Integer
Public intMsgType As Integer
Public intListIndex As Integer
Public intListMode As Integer
Public intTLimit As Integer
Public intTimeCurrent As Integer
Public intTimeLeft As Integer
Public strMURL As String
Public strWL As String
Public strRMain As String
Public strRS As String
Public strRR As String
Public strRS1 As String
Public strRR1 As String
Public strMsgTitle As String
Public strMsgDescription As String
Public strName As String
Public strEmail As String
Public strAppVersion As String
Public Const strAppTitle As String = "Easy Emailer 2.4 - [Limited version]"

Public Sub Main()

    strAppVersion = App.Major & "." & App.Minor
    Initialize_UI_Controls
    
    On Error Resume Next
    'Checking application's previous instances.
    If App.PrevInstance Or IsAppRunning(GetMutexName()) Then AppActivate strAppTitle: End
    'If App.LogMode = 0 Then MsgBox "For a better performance run the compiled executable," & vbCrLf & _
                                   "where this message is not displayed.", vbInformation
                                   
    LoadResInfo
    frmSplash.Show
    
End Sub

'Prepair the controls to get the modern OS styles.
Private Sub Initialize_UI_Controls()

    On Local Error GoTo Err
    
    Dim iccex As tagInitCommonControlsEx
        With iccex
          .lngSize = LenB(iccex)
          .lngICC = ICC_USEREX_CLASSES
        End With
    InitCommonControlsEx iccex
    Exit Sub
Err:
    Err.Clear
    
End Sub

'Load resource strings.
Public Sub LoadResInfo()

    Dim cLCrypto As clsLightCrypto
    
    Set cLCrypto = New clsLightCrypto
   
    With cLCrypto
        .Key = LoadResString(101)
        strMURL = .EncryptDecrypt(LoadResString(102), False)
        strWL = .EncryptDecrypt(LoadResString(103), False)
        strRMain = .EncryptDecrypt(LoadResString(104), False)
        strRS = .EncryptDecrypt(LoadResString(105), False)
        strRR = .EncryptDecrypt(LoadResString(106), False)
        strRS1 = .EncryptDecrypt(LoadResString(107), False)
        strRR1 = .EncryptDecrypt(LoadResString(108), False)
        intTLimit = .EncryptDecrypt(LoadResString(111), False)
    End With
    
    Set cLCrypto = Nothing
    
End Sub

'Function to select the texts in editable controls or to place the cursor at the end of the text.
Public Sub SelectOnFocus(ByVal ctrlActiveControl As Control, Optional blnEndCursor As Boolean = False)

    On Error Resume Next
    
    With ctrlActiveControl
        .SetFocus
        If blnEndCursor = True Then
            .SelStart = Len(.Text)
        Else
            .SelStart = 0
            .SelLength = Len(.Text)
        End If
    End With
    
End Sub

'Moving forms with the use of controls.
Public Sub GetMove(ByRef frmForm As Form)

    Dim lReturnValue As Long
    
    Call ReleaseCapture
    lReturnValue = SendMessage(frmForm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    
End Sub

'Checking whether the application is already running.
Private Function IsAppRunning(ByVal strMutexName As String) As Boolean
    
    On Error GoTo MutextError

    Dim lngMutex As Long
    
    IsAppRunning = False

    If App.LogMode = 1 Then
        lngMutex = CreateMutex(ByVal 0&, 1, strMutexName)
        
        If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
            ReleaseMutex lngMutex
            CloseHandle lngMutex
            Err.Clear
            IsAppRunning = True
        End If
    End If
    
    Exit Function
    
MutextError:
    IsAppRunning = True
    
End Function

'Checking duplicate items in a given list.
Public Function CheckListItem(ByVal lstBox As ListBox, ByVal strItem As String) As Boolean

    Dim i As Integer
    
    CheckListItem = False
    
    For i = 0 To lstBox.ListCount - 1
        'If StrComp(Lst.List(i), sItem, vbTextCompare) Then
        If UCase(lstBox.List(i)) = UCase(strItem) Then
            CheckListItem = True
            Exit For
        End If
    Next
    
End Function

'Adding horizontal ScrollBar to a given ListBox based on its items.
Public Function SetListBoxHBar(ByVal lstBox As ListBox, frmForm As Form)

    On Error Resume Next
    
    Dim lngReturn As Long
    Dim lngExtent As Long
    Dim i As Integer
    
    With frmForm
        .ScaleMode = 1
        .Font = lstBox.Font
        .FontBold = lstBox.FontBold
        .FontItalic = lstBox.FontItalic
        .FontSize = lstBox.FontSize
        For i = 0 To lstBox.ListCount - 1
            If lngExtent < .TextWidth(lstBox.List(i)) Then lngExtent = .TextWidth(lstBox.List(i))
        Next i
    End With
    
    lngReturn = SendMessage(lstBox.hwnd, LB_SETHORIZONTALEXTENT, lngExtent / Screen.TwipsPerPixelX + 6, 0&)
    
End Function

'Get the list index of the selected Item at Mouse right click in a listbox.
Public Function GetRClickedItem(ByVal lstBox As ListBox, X As Single, Y As Single) As Long
  
    Dim clickX As Long, clickY As Long
    Dim lRet As Long
    Dim CurRect As RECT
    Dim l As Long
  
    'get x and y in pixels
    clickX = X \ Screen.TwipsPerPixelX
    clickY = Y \ Screen.TwipsPerPixelY
    
    GetRClickedItem = -1

    'Check all items in the list to see if it was clicked on
    For l = 0 To lstBox.ListCount - 1

      'get current selection as rectangle
      lRet = SendMessage(lstBox.hwnd, LB_GETITEMRECT, l, CurRect)

      'If the position of the click is in the this list item
       'then that's  our Item

     If (clickX >= CurRect.Left) And (clickX <= CurRect.Right) _
       And (clickY >= CurRect.Top) And _
          (clickY <= CurRect.Bottom) Then

            GetRClickedItem = l
            Exit Function
        End If

    Next l

End Function

'Basic email address validator.
Public Function IsValidEmail(ByVal strEA As String) As Boolean
    
    Dim blnValid As Boolean
        
    If InStr(strEA, "@") Then
        If InStr(strEA, ".") Then
            blnValid = True
        Else
            blnValid = False
        End If
    Else
        blnValid = False
    End If
    
    IsValidEmail = blnValid
    
End Function

'Popup a custom message with various options.
Public Sub PopupMessage(ByVal strMDes As String, Optional strMTitle As String = "Easy Emailer", Optional intMType As Integer = 0)

    strMsgDescription = strMDes
    strMsgTitle = strMTitle
    intMsgType = intMType
    frmMessage.Show 1
    
End Sub

'Check for the Internet connection.
Public Function CheckConnection() As Boolean
    
    If InternetGetConnectedStateEx(0, vbNullString, 512, 0&) Then
        CheckConnection = True
    Else
        CheckConnection = False
    End If
    
    CheckConnection = CheckConnection
    
End Function

'Get ID.
Public Function GetUID() As String
    
    Dim cLCrypto As New clsLightCrypto
    
    With cLCrypto
        .Key = LoadResString(101)
        GetUID = .EncryptDecrypt(LoadResString(109), False)
    End With
    
    Set cLCrypto = Nothing
    
End Function

'Get the decrypted name for the mutex for application instance level security.
Public Function GetMutexName() As String
    
    Dim cLCrypto As New clsLightCrypto
    
    With cLCrypto
        .Key = LoadResString(101)
        GetMutexName = .EncryptDecrypt(LoadResString(110), False)
    End With
    
    Set cLCrypto = Nothing
    
End Function

'Enable/Disable Close button.
Public Function EnableCloseButton(ByVal hwnd As Long, blnState As Boolean) As Integer

    Const xSC_CLOSE As Long = -10

    'Check that the window handle passed is valid
    
    EnableCloseButton = -1
    If IsWindow(hwnd) = 0 Then Exit Function
    
    ' Retrieve a handle to the window's system menu
    
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 0)
    
    ' Retrieve the menu item information for the close menu item/button
    
    Dim MII As MENUITEMINFO
    MII.cbSize = Len(MII)
    MII.dwTypeData = String(80, 0)
    MII.cch = Len(MII.dwTypeData)
    MII.fMask = MIIM_STATE
    
    If blnState Then
        MII.wID = xSC_CLOSE
    Else
        MII.wID = SC_CLOSE
    End If
    
    EnableCloseButton = -0
    If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
    
    ' Switch the ID of the menu item so that VB can not undo the action itself
    
    Dim lngMenuID As Long
    lngMenuID = MII.wID
    
    If blnState Then
        MII.wID = SC_CLOSE
    Else
        MII.wID = xSC_CLOSE
    End If
    
    MII.fMask = MIIM_ID
    EnableCloseButton = -2
    If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Exit Function
    
    ' Set the enabled / disabled blnState of the menu item
    
    If blnState Then
        MII.fState = (MII.fState Or MFS_GRAYED)
        MII.fState = MII.fState - MFS_GRAYED
    Else
        MII.fState = (MII.fState Or MFS_GRAYED)
    End If
    
    MII.fMask = MIIM_STATE
    EnableCloseButton = -3
    If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
    
    ' Activate the non-client area of the window to update the titlebar, and
    ' draw the close button in its new blnState.
    
    SendMessage hwnd, WM_NCACTIVATE, True, 0
    
    EnableCloseButton = 0
    
End Function

'Set Topmost ON/OFF.
Public Sub SetTopMost(ByVal frmForm As Form, ByVal blnStatus As Boolean)

    If blnStatus Then
        SetWindowPos frmForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
    Else
        SetWindowPos frmForm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
    End If
    
End Sub
