Attribute VB_Name = "Module1"
'Option Explicit
Public fMainForm As frmMain

'Declare New CommonDialog class
Public cFile As New clsFileOpenSave
Public SFile As String  'Saved/opened Config File Name

'API for Writing to .ini files (or in this case .rnm files)
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'API Declaration, Type Structure and Constants for minimizing to system tray
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
    (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Public Const ICO_ERR = 6
Public Const ICO_INFO = 7
Public Const ICO_QUESTION = 8
Public Const ICO_CAUTION = 9

Public Const NIM_ADD = &H0     ' Add an icon
Public Const NIM_MODIFY = &H1  ' Modify an icon
Public Const NIM_DELETE = &H2  ' Delete an icon
Public Const NIF_MESSAGE = &H1        ' To change uCallBackMessage member
Public Const NIF_ICON = &H2           ' To change the icon
Public Const NIF_TIP = &H4            ' To change the tooltip text
'nid.uFlags = NIF_ICON Or NIF_TIP Or  NIF_MESSAGE
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201    ' Left click
Public Const WM_LBUTTONDBLCLK = &H203  ' Left double click
Public Const WM_RBUTTONDOWN = &H204    ' Right click
Public Const WM_RBUTTONDBLCLK = &H206  ' Right double click
Public Const WM_RBUTTONUP = &H205
Public nid As NOTIFYICONDATA

'Constant for launching web browser
Public Const SW_SHOW = 5

'API for Mapping Network Drives
Public Declare Function WNetConnectionDialog Lib "mpr.dll" _
    (ByVal hwnd As Long, ByVal dwType As Long) As Long
    
'Windows API/Global Declarations & constants for Reading and Writing to the Registry
'Required in order to create file associations
Public Const REG_SZ As Long = &H1
Public Const REG_DWORD As Long = &H4
Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_USERS As Long = &H80000003
Public Const ERROR_SUCCESS As Long = 0
Public Const ERROR_BADDB As Long = 1009
Public Const ERROR_BADKEY As Long = 1010
Public Const ERROR_CANTOPEN As Long = 1011
Public Const ERROR_CANTREAD As Long = 1012
Public Const ERROR_CANTWRITE As Long = 1013
Public Const ERROR_OUTOFMEMORY As Long = 14
Public Const ERROR_INVALID_PARAMETER As Long = 87
Public Const ERROR_ACCESS_DENIED As Long = 5
Public Const ERROR_MORE_DATA As Long = 234
Public Const ERROR_NO_MORE_ITEMS As Long = 259
Public Const KEY_ALL_ACCESS As Long = &H3F
Public Const REG_OPTION_NON_VOLATILE As Long = 0

Public Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Public Declare Function RegCreateKeyEx _
    Lib "advapi32.dll" Alias "RegCreateKeyExA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    ByVal Reserved As Long, _
    ByVal lpClass As String, _
    ByVal dwOptions As Long, _
    ByVal samDesired As Long, _
    ByVal lpSecurityAttributes As Long, _
    phkResult As Long, _
    lpdwDisposition As Long) As Long

Public Declare Function RegOpenKeyEx _
    Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long

Public Declare Function RegSetValueExString _
    Lib "advapi32.dll" Alias "RegSetValueExA" _
    (ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    ByVal lpValue As String, _
    ByVal cbData As Long) As Long

Public Declare Function RegSetValueExLong _
    Lib "advapi32.dll" Alias "RegSetValueExA" _
    (ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    lpValue As Long, _
    ByVal cbData As Long) As Long
    
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As _
OSVERSIONINFO) As Long

'custom data type to hold OS info
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

'clipboard constants & API
Public Const WM_CUT = &H300
Public Const WM_COPY = &H301
Public Const WM_PASTE = &H302
Public Const WM_CLEAR = &H303

' for Auto Scrolling the Log
Public Const WM_USER = &H400
Public Const EM_GETSCROLLPOS = (WM_USER + 221)
Public Const EM_SETSCROLLPOS = (WM_USER + 222)
Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_CHARFROMPOS = &HD7
Public Const EM_GETLINECOUNT = &HBA

Public Type POINTL
    x As Long
    y As Long
End Type

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

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

'Needed for pasting data to Rich Text Box
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

'variable to tell us if any of the values have been changed
' so that we can prompt to save changes somewhat intelligently
Public IsDirty As Boolean

Function GetWindowsVersion()

Dim osVer As OSVERSIONINFO
Dim lngRetVal As Long
Dim strVer As String

osVer.dwOSVersionInfoSize = Len(osVer)

lngRetVal = GetVersionEx(osVer)

If lngRetVal = 0 Then
    'there was an error obtaining version info
    GetWindowsVersion = "Unable to get version information."
    Exit Function
End If

Select Case osVer.dwPlatformId
'Find out if its NT or 9x
Case 1
    strVer = "Microsoft Windows 9x "
Case 2
    strVer = "Microsoft Windows NT "
End Select

'add on the version number
strVer = strVer & osVer.dwMajorVersion & "." & osVer.dwMinorVersion & " [Build " & _
osVer.dwBuildNumber & "]"

GetWindowsVersion = strVer

'The function will return the windows version in the form:
'Microsoft Windows NT 5.0 [Build 2195]

End Function

'Create File Association
Public Sub CreateAssociation(sExtension As String, sApplication As String, sAppPath As String)
    Dim sPath As String
    'Create .rnm key in HKEY_CLASSES_ROOT
    CreateNewKey "." & sExtension, HKEY_CLASSES_ROOT
    'Set value to point to Renamer.Document
    SetKeyValue "." & sExtension, "", sApplication & ".Document", REG_SZ
    'Create Renamer.Document shell\open\command key
    CreateNewKey sApplication & ".Document\shell\open\command", HKEY_CLASSES_ROOT
    'Set Value
    SetKeyValue sApplication & ".Document", "", sApplication & " Document", REG_SZ
    'Define Path for Shell Execute so that when double click on .rnm file it launches this application
    sPath = Chr(34) & sAppPath & "\" & sApplication & ".exe " & Chr(34) & "%1" & Chr(34) & Chr(34)
    'Assign that shell path to key
    SetKeyValue sApplication & ".Document\shell\open\command", "", sPath, REG_SZ
    'Assign DefaultIcon to .rnm files (Renamer Application icon)
    CreateNewKey sApplication & ".Document\DefaultIcon", HKEY_CLASSES_ROOT
    SetKeyValue sApplication & ".Document\DefaultIcon", "", Chr(34) & sAppPath & "\" & sApplication & ".exe" & Chr(34) & ", 0", REG_SZ
    'Add Remaining Keys
    CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." _
    & sExtension, HKEY_CURRENT_USER
    SetKeyValue2 "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." _
    & sExtension, "Application", sApplication, REG_SZ
    CreateNewKey "Applications\" & sApplication & "\shell\open\command", HKEY_CLASSES_ROOT
    SetKeyValue "Applications\" & sApplication & "\shell\open\command", "", sPath, REG_SZ
End Sub

'Function to Set value
Public Function SetValueEx(ByVal hKey As Long, _
    sValueName As String, _
    lType As Long, _
    vValue As Variant) As Long
    Dim nValue As Long
    Dim sValue As String

    Select Case lType
        Case REG_SZ
        sValue = vValue & Chr$(0)
        SetValueEx = RegSetValueExString(hKey, _
        sValueName, _
        0&, _
        lType, _
        sValue, _
        Len(sValue))
        Case REG_DWORD
        nValue = vValue
        SetValueEx = RegSetValueExLong(hKey, _
        sValueName, _
        0&, _
        lType, _
        nValue, _
        4)
    End Select
End Function

'Function to Create new Registry Key
Public Sub CreateNewKey(sNewKeyName As String, _
    lPredefinedKey As Long)
    Dim hKey As Long
    Dim result As Long
    Call RegCreateKeyEx(lPredefinedKey, _
    sNewKeyName, 0&, _
    vbNullString, _
    REG_OPTION_NON_VOLATILE, _
    KEY_ALL_ACCESS, 0&, hKey, result)
    Call RegCloseKey(hKey)
End Sub

'Function to set new Registry Key
Public Sub SetKeyValue(sKeyName As String, _
    sValueName As String, _
    vValueSetting As Variant, _
    lValueType As Long)
    Dim hKey As Long
    Call RegOpenKeyEx(HKEY_CLASSES_ROOT, _
    sKeyName, 0, _
    KEY_ALL_ACCESS, hKey)
    Call SetValueEx(hKey, _
    sValueName, _
    lValueType, _
    vValueSetting)
    Call RegCloseKey(hKey)
End Sub

'Function to set Registry Key
Public Sub SetKeyValue2(sKeyName As String, _
    sValueName As String, _
    vValueSetting As Variant, _
    lValueType As Long)
    Dim hKey As Long
    Call RegOpenKeyEx(HKEY_CURRENT_USER, _
    sKeyName, 0, _
    KEY_ALL_ACCESS, hKey)
    Call SetValueEx(hKey, _
    sValueName, _
    lValueType, _
    vValueSetting)
    Call RegCloseKey(hKey)
End Sub

'The Main Program that runs when the .exe is launched
Sub Main()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'**************************************************************
' Create File Associations code
' In the end, we decided to create a Wise Install Program for Renamer which will create
' the file associations for us. Therefore this code is no longer needed, but we left it in
' as it may prove useful
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    Dim fileAssoc
'    'check for file association
'    fileAssoc = GetSetting(App.Title, "Settings", "fileAssoc", False)
'    If fileAssoc = False Then
'        'set file association
'        CreateAssociation "rnm", "Renamer", App.Path
'        'Record the fact that the file has been associated so that don't reassociate
'        'every time program is running (faster loads)
'        SaveSetting App.Title, "Settings", "fileAssoc", True
'    End If
'**************************************************************
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Create main MDI form and display it
    Set fMainForm = New frmMain
    Load fMainForm
    fMainForm.Show
End Sub

'Write Settings to specified filename or to default.rnm if unspecified
'Settings are for whole program - Number of Windows open, etc, not just contents of a single file renamer window.
Public Sub writeprofilesettings(InFileName$)

    On Error GoTo Error_Handler     'trap errors

    'If no file specified write to default.rnm
    If InFileName$ = "" Then
        lpFileName$ = App.Path
        If Right$(lpFileName$, 1) <> "\" Then lpFileName$ = lpFileName$ + "\"
        lpFileName$ = lpFileName$ + "default.rnm"
    Else
        lpFileName$ = InFileName$
    End If
    
    'initialize variables
    NumSessions% = Forms.Count - 1  'Number of open windows (- main MDI window)
    lpAppName$ = "Renamer"          'Program name
    lpKeyName$ = "NumSessions"
    lpString$ = Format$(NumSessions%)
    'Write number of windows to .rnm file
    junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
    
    'Record Window state (Minimized, maximized, etc)
    lpKeyName$ = "WindowState"
    lpString$ = Format$(Forms(0).WindowState)
    junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
    
    'For each open child window
    For x% = 1 To NumSessions%
        'Insert Heading e.g. [Session1]
        lpAppName$ = "Session" + Format$(x%)
         
        'Record Input File
        lpKeyName$ = "InputFile"
        lpString$ = Format$(Forms(x%).Text1.Text)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
         
        'File Extension
        lpKeyName$ = "FileExtension"
        lpString$ = Format$(Forms(x%).Text2.Text)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
        
        'Preamble text
        lpKeyName$ = "Preamble"
        lpString$ = Format$(Forms(x%).txtPreAmble.Text)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
        
        'Hour
        lpKeyName$ = "Hour"
        lpString$ = Format$(Forms(x%).cboHour.ListIndex)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
        
        'Minutes
        lpKeyName$ = "Min"
        lpString$ = Format$(Forms(x%).cboMin.Text)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
        
        'AM/PM
        lpKeyName$ = "AmPm"
        lpString$ = Format$(Forms(x%).cboAmPm.ListIndex)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
        
        'Frequency
        lpKeyName$ = "Frequency"
        lpString$ = Format$(Forms(x%).Combo1.ListIndex)
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)

        
        'was the session Active?
        lpKeyName$ = "AutoActivate"
        lpString$ = "0"
        If Forms(x%).cmdActivate.Caption = "Deactivate" Then lpString$ = "1"
        junk& = WritePrivateProfileString(lpAppName$, lpKeyName$, lpString$, lpFileName$)
    Next
    
Exit_Normal:
    Exit Sub

Error_Handler:
    'On error display message box, then exit this routine
    'MsgBox "Error Saving Settings: " & Err.Number & " : " & Err.Description, vbCritical, "Renamer"
    'Update log
    updateLog ICO_ERR, " " & Now & " : Error Saving Settings: " & Err.Number & " : " & Err.Description
    Resume Exit_Normal
End Sub

Public Function generate_Error_Log(Err_obj As ErrObject)
   
    On Error GoTo ErrorHandler              ' trap errors
    'Get windows version
    strVersion = GetWindowsVersion

    Open App.Path & "\RenamerErrors.txt" For Append As #1
    Print #1, Now & " : " & "Error Details: " & Err_obj.Number & " : " & Err_obj.Description & vbCr & vbLf
    Print #1, "Windows version: " & strVersion & ", Renamer Version: " & "Version " & App.Major & "." & App.Minor & "." & App.Revision & vbCr & vbLf
    Close #1

Normal_Exit:
    Exit Function
    
ErrorHandler:
    'Forms(0).sbStatusBar.Panels(1).Text = "Error Log could not be updated"
    'Update log
    updateLog ICO_ERR, " " & Now & " : Error Updating Log: " & Err.Number & " : " & Err.Description
    Resume Normal_Exit
End Function

Public Sub updateLog(picNum As Long, strMsg As String)

    Dim lPos As Long
    Dim pt As POINTL
    Dim r As RECT
    Dim lCount As Long
    Dim sTemp As String
    Dim l As Long
    
    'get current data from clipboard
    Clip = ""
    If Clipboard.GetText > "" Then Clip = Clipboard.GetText
    
    Clipboard.Clear
    Clipboard.SetData Forms(0).imlToolbarIcons.ListImages(picNum).Picture, vbCFBitmap
        
    Forms(0).rtbHistory.Locked = False
        
    If Str(Clipboard.GetData) <> 0 Then SendMessage Forms(0).rtbHistory.hwnd, WM_PASTE, 0, 0
    Clipboard.Clear
    
    With Forms(0).rtbHistory
        lCount = SendMessage(.hwnd, EM_GETLINECOUNT, 0, ByVal 0&) - 1
        GetClientRect .hwnd, r
        pt.x = r.Left + 1
        pt.y = r.Bottom - 1
        lPos = SendMessage(.hwnd, EM_CHARFROMPOS, 0, pt)
        lPos = SendMessage(.hwnd, EM_LINEFROMCHAR, lPos, ByVal 0&)
        If lPos < lCount Then 'do not scroll
            l = SendMessage(.hwnd, EM_GETSCROLLPOS, 0, pt)
            'Update log
            Clipboard.SetText strMsg & vbCrLf
            SendMessage Forms(0).rtbHistory.hwnd, WM_PASTE, 0, 0
            l = SendMessage(.hwnd, EM_SETSCROLLPOS, 0, pt)
        Else
            'Update log
            Clipboard.SetText strMsg & vbCrLf
            SendMessage Forms(0).rtbHistory.hwnd, WM_PASTE, 0, 0
            .SelStart = Len(.Text)
        End If
    End With
    
    Forms(0).rtbHistory.Locked = True
    
    'Restore original clipboard text
    Clipboard.Clear
    If Clip > "" Then Clipboard.SetText Clip
End Sub
