Attribute VB_Name = "modFileSupport"
Option Explicit

'shell command support
Public Const SW_SHOWNORMAL = 1
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
  (ByVal hWnd As Long, ByVal lpOperation As Long, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'system command support
Private Declare Function ShellExecuteEx Lib "shell32" (SEI As SHELLEXECUTEINFO) As Long
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400

Private Type SHELLEXECUTEINFO
    cbSize        As Long
    fMask         As Long
    hWnd          As Long
    lpVerb        As String
    lpFile        As String
    lpParameters  As String
    lpDirectory   As String
    nShow         As Long
    hInstApp      As Long
    lpIDList      As Long
    lpClass       As String
    hkeyClass     As Long
    dwHotKey      As Long
    hIcon         As Long
    hProcess      As Long
End Type

'dynamic array support
Public Type ArrayIndex
    idxL As Long 'index lower record
    idxU As Long 'index upper record
End Type

'gets current index range of 1 dim array
Public Function GetArrayIndex(varArray As Variant) As ArrayIndex
    GetArrayIndex.idxL = LBound(varArray)
    GetArrayIndex.idxU = UBound(varArray)
End Function

Public Function GetDataIndex(strMCAData As Variant) As ArrayIndex
    Dim FileNum As Integer
    Dim iSize As ArrayIndex
    Dim iData As ArrayIndex
    Dim i As Long
    On Error GoTo GetDataIndexErr

    GetDataIndex.idxL = -1              'indicates not found
    GetDataIndex.idxU = -1              'indicates not found
    
    iSize = GetArrayIndex(strMCAData)   'get the indices of the array for
    For i = iSize.idxL To iSize.idxU
        If (StrComp(strMCAData(i), "<<DATA>>", vbTextCompare) = 0) Then GetDataIndex.idxL = i + 1
        If (StrComp(strMCAData(i), "<<END>>", vbTextCompare) = 0) Then GetDataIndex.idxU = i - 1
    Next
    
    Exit Function
GetDataIndexErr:
    GetDataIndex.idxL = -1              'indicates not found
    GetDataIndex.idxU = -1              'indicates not found
    MsgBox "GetDataIndex " & Err.Description, vbCritical
End Function

''<<CALIBRATION>>
''Label -keV
''699.45 5.89
''769.71 6.49
''<<ROI>>
''654 743
''739 805
''<<DATA>>
Public Function GetCalIndex(strMCAData As Variant) As ArrayIndex
    Dim FileNum As Integer
    Dim iSize As ArrayIndex
    Dim iData As ArrayIndex
    Dim i As Long
    On Error GoTo GetCalIndexErr

    GetCalIndex.idxL = -1              'indicates not found
    GetCalIndex.idxU = -1              'indicates not found
    iSize = GetArrayIndex(strMCAData)   'get the indices of the array for
    For i = iSize.idxL To iSize.idxU
        If (StrComp(strMCAData(i), "<<CALIBRATION>>", vbTextCompare) = 0) Then GetCalIndex.idxL = i + 1
        If (StrComp(strMCAData(i), "<<ROI>>", vbTextCompare) = 0) Then GetCalIndex.idxU = i - 1         'roi found, end of cal
        If ((StrComp(strMCAData(i), "<<DATA>>", vbTextCompare) = 0) And (GetCalIndex.idxU = -1)) Then   'if no roi found
            GetCalIndex.idxU = i - 1                                                                    'end of cal is at data
        End If
    Next
    Exit Function
GetCalIndexErr:
    GetCalIndex.idxL = -1              'indicates not found
    GetCalIndex.idxU = -1              'indicates not found
    MsgBox "GetCalIndex " & Err.Description, vbCritical  'cal may
End Function

Public Function GetROIIndex(strMCAData As Variant) As ArrayIndex
    Dim FileNum As Integer
    Dim iSize As ArrayIndex
    Dim iData As ArrayIndex
    Dim i As Long
    On Error GoTo GetROIIndexErr

    GetROIIndex.idxL = -1              'indicates not found
    GetROIIndex.idxU = -1              'indicates not found
    
    iSize = GetArrayIndex(strMCAData)   'get the indices of the array for
    For i = iSize.idxL To iSize.idxU
        If (StrComp(strMCAData(i), "<<ROI>>", vbTextCompare) = 0) Then GetROIIndex.idxL = i + 1
        If (StrComp(strMCAData(i), "<<DATA>>", vbTextCompare) = 0) Then GetROIIndex.idxU = i - 1    'roi is always ends at data
    Next
    Exit Function
GetROIIndexErr:
    GetROIIndex.idxL = -1              'indicates not found
    GetROIIndex.idxU = -1              'indicates not found
    MsgBox "GetROIIndex " & Err.Description, vbCritical
End Function

Public Function GetMcaFile(strFile As String) As Variant
    Dim FileNum As Integer
    Dim strFileArr() As String
    Dim iSize As Integer
    Dim TextLine As String
    Dim lRes As Long
    Dim i As Long
    
    iSize = 0
    FileNum = FreeFile
    Open strFile For Input As #FileNum
    Do While Not EOF(FileNum)
        ReDim Preserve strFileArr(iSize)
        strFileArr(iSize) = ""
        Line Input #FileNum, TextLine
        strFileArr(iSize) = TextLine
        iSize = iSize + 1
    Loop
    Close #FileNum
    'old files have a linefeed (&H0A) vbLF as a line terminator
    'only vbCR + vbLF or vbCR are valid line terminators
    'files terminated with vbLF are read into one string only
    'the string must be manually split up
    lRes = InStr(1, strFileArr(0), "<<END>>", vbTextCompare)
    If ((iSize = 1) And (lRes > 0)) Then
        'MsgBox "You can update old mca files by reading into wordpad and saving as text"
        lRes = 0
        For i = 1 To Len(TextLine)
            If (Mid(TextLine, i, 1) = vbLf) Then lRes = lRes + 1
        Next

        iSize = 0
        Do While ((Len(TextLine) > 0) And (iSize < (lRes + 2)))
            ReDim Preserve strFileArr(iSize)
            strFileArr(iSize) = GetNextLine(TextLine, vbLf)
            iSize = iSize + 1
        Loop
    End If
    GetMcaFile = strFileArr
End Function

'get next var then remove from list
Private Function GetNextLine(ByRef strList As String, strTerm As String) As String
    On Error Resume Next
    Dim strVar As String
    Dim VarPos As Long
    GetNextLine = ""
    VarPos = InStr(1, strList, strTerm)     'normal line terminator
    If (VarPos > 0) Then
        strVar = Trim(Left(strList, VarPos - 1))
        If (Len(strVar) > 0) Then
            GetNextLine = strVar
            strList = Mid(strList, (VarPos + Len(strTerm)))
            Exit Function
        End If
    End If
    VarPos = Len(strList)
    If (VarPos > 0) Then
        strVar = Trim(strList)
        If (Len(strVar) > 0) Then
            GetNextLine = strVar
            strList = ""
            Exit Function
        End If
    End If
End Function

Public Sub CreateNewMcaFile(strFile As String, strMCAData As Variant)
    Dim FileNum As Integer
    Dim iSize As ArrayIndex
    Dim i As Long

    iSize = GetArrayIndex(strMCAData)
    FileNum = FreeFile
    Open strFile For Output As #FileNum
    For i = iSize.idxL To iSize.idxU
        Print #FileNum, strMCAData(i)
    Next
    Close #FileNum
End Sub

'tests if a file exists
Public Function FileExists(ByVal strFilename As String) As Boolean
    Dim strFile As String
    On Error Resume Next
    strFile = Trim(strFilename)         'trim whitespace
    If (Err Or (Len(strFile) = 0)) Then 'no filename, don't do test
        FileExists = False
        Exit Function
    End If
    If ((Mid(strFile, 1, 1) = """") And (Right(strFile, 1) = """")) Then 'Remove quotes
        If (Len(strFile) > 2) Then      'quoted string, remove quotes
            strFile = Mid(strFile, 2, Len(strFile) - 2)
        Else                            'quoted empty string, exit before dir test
            FileExists = False
            Exit Function
        End If
    End If
    strFile = Dir(strFile)
    If (Err) Then                       'could be bad chars etc
        FileExists = False
    Else
        FileExists = (strFile <> "")
    End If
End Function

'-----------------------------------------------------------
' SUB: AddDirSep
' Add a trailing directory path separator (back slash) to the
' end of a pathname unless one already exists
'
' IN/OUT: [strPathName] - path to add separator to
'-----------------------------------------------------------
Sub AddDirSep(strPathName As String)
    Const gstrSEP_DIR$ = "\"                         ' Directory separator character
    Const gstrSEP_URLDIR$ = "/"                      ' Separator for dividing directories in URL addresses.
    If Right(Trim(strPathName), Len(gstrSEP_URLDIR)) <> gstrSEP_URLDIR And _
       Right(Trim(strPathName), Len(gstrSEP_DIR)) <> gstrSEP_DIR Then
        strPathName = RTrim$(strPathName) & gstrSEP_DIR
    End If
End Sub

'-----------------------------------------------------------
' FUNCTION: DirExists
' Determines whether the specified directory name exists.
' This function is used (for example) to determine whether
' an installation floppy is in the drive by passing in
' something like 'A:\'.
' IN: [strDirName] - name of directory to check for
' Returns: True if the directory exists, False otherwise
'-----------------------------------------------------------
Public Function DirExists(ByVal strDirName As String) As Integer
    Const strWILDCARD$ = "*.*"
    Const gstrNULL$ = ""
    Dim strDummy As String
    On Error Resume Next
    AddDirSep strDirName
    strDummy = Dir$(strDirName & strWILDCARD, vbDirectory)
    DirExists = Not (strDummy = gstrNULL)
    Err = 0
End Function

'###################################################################################
'# Function Name    :   DisplaySystemInfoDialog
'# Desc             :   Displays the system information dialog for an object given a valid path
'#
'#                      strFilePath  = Valid System Path
'#                      hWnd = The window handle of the calling window
'#
'# Example Use      :
'#          DisplaySystemInfoDialog ValidSystemPath, Me.hWnd
'#
'# Returns          :   nothing
'###################################################################################
Public Sub DisplaySystemInfoDialog(strFilePath As String, hWnd As Long)
    Dim SEI As SHELLEXECUTEINFO
    With SEI                    'Fill in the SHELLEXECUTEINFO structure
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or _
                 SEE_MASK_INVOKEIDLIST Or _
                 SEE_MASK_FLAG_NO_UI
        .hWnd = hWnd
        .lpVerb = "properties"
        .lpFile = (strFilePath)
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With
    Call ShellExecuteEx(SEI)    'call the ShellExecuteEx API
End Sub