Attribute VB_Name = "modUtil"
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: modUtil.bas
'   Purpose: General utility functions
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0


' Consts used in OpenProcess function
Const PROCESS_TERMINATE = &H1
Const PROCESS_QUERY_INFORMATION = &H400
Const PROCESS_VM_READ = &H10

' Consts used in SendMessage function
Const WM_CLOSE = &H10

' Consts used in SetWindowPos function
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

' Consts used in ProgBar functions
Const WM_USER = &H400
Const CCM_FIRST = &H2000&
Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Const PBM_SETBKCOLOR = CCM_SETBKCOLOR
Const PBM_SETBARCOLOR = (WM_USER + 9)

' Menu info for a form
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

' Win32 data for describing a file's time\date
Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

' Win32 data for finding a file....?
Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 14
End Type

' Type for GetWindowRect API
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' API calls
Declare Function FindFirstFile Lib "KERNEL32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "KERNEL32" (ByVal hFindFile As Long) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal IpClassName As String, ByVal IpWindowName As String) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
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 Declare Sub Sleep Lib "KERNEL32" (ByVal ms As Long)
 

' Determine if a string point to a picture
Public Function IsPicture(PicturePathName As String) As Boolean

    Dim Pic As Picture

    On Error GoTo Err_Handling
    
    Set Pic = LoadPicture(PicturePathName)
    If IsNull(Pic) = False Then
        IsPicture = True
    End If
    Set Pic = Nothing
    
    Exit Function
    
Err_Handling:
IsPicture = False
    
End Function


' Determine if a form is loaded (use string var and not form var because invoking form var loads form itself)
Public Function FormIsLoad(frmName As String) As Boolean

    Dim frm As Form
    
    On Error GoTo Err_Handling
    
    For Each frm In Forms
        If frmName = frm.Name Then
            FormIsLoad = True
        End If
    Next frm
    
    Exit Function

Err_Handling:
FormIsLoad = False

End Function

' Set form to top (front) position
Public Sub SetFormTop(frm As Form)
    
    frm.Visible = True
    frm.WindowState = vbNormal
    SetWindowPos frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
    
End Sub

' Find Tray bar height (in twips)
Public Function TrayBarHeight() As Long
    
    Dim hwnd As Long
    Dim Bar As RECT
    
    ' tray bar handle
    hwnd = FindWindowEx(0&, 0&, "Shell_TrayWnd", vbNullString)
    ' tray bar dimensions
    GetWindowRect hwnd, Bar
    ' if tray bar is elsewhere than top, then result is 0
    If Bar.Top > 0 Then
        TrayBarHeight = Screen.Height - (Bar.Top * Screen.TwipsPerPixelY)
    End If

End Function


' Enable or disable a form's close button
Public Function EnableCloseButton(ByVal hwnd As Long, Enable As Boolean) As Integer
    
    Dim hMenu As Long
    Dim MII As MENUITEMINFO
    Dim lngMenuID As Long
    
    Const xSC_CLOSE As Long = -10
    Const SC_CLOSE As Long = &HF060&
    Const MIIM_STATE As Long = &H1&
    Const MIIM_ID As Long = &H2&
    Const MFS_GRAYED As Long = &H3&
    Const WM_NCACTIVATE As Long = &H86

    ' 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
    hMenu = GetSystemMenu(hwnd, 0)
    
    ' Retrieve the menu item information for the close menu item/button
    MII.cbSize = Len(MII)
    MII.dwTypeData = String(80, 0)
    MII.cch = Len(MII.dwTypeData)
    MII.fMask = MIIM_STATE
    
    If Enable 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
    lngMenuID = MII.wID
    If Enable 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 state of the menu item
    If Enable 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 state.
    SendMessage hwnd, WM_NCACTIVATE, True, 0
    
    EnableCloseButton = 0
    
End Function


' Autosize ListView columns width
Public Sub ListViewAutoSize(refLVW As ListView, Optional refCOL As Long = 0)

    Dim lCol As Long

    Const LVM_FIRST As Long = &H1000
    Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
    Const LVSCW_AUTOSIZE As Long = -1
    Const LVSCW_AUTOSIZE_USEHEADER As Long = -2
   
    For lCol = refCOL To refLVW.ColumnHeaders.Count - 1
        Call SendMessage(refLVW.hwnd, LVM_SETCOLUMNWIDTH, lCol, ByVal LVSCW_AUTOSIZE_USEHEADER)
    Next

End Sub


' Set the ProgressBar foreground color
Public Function ProgBarForeColor(ProgBarHwnd As Long, NewForeColor As Long)

    Call SendMessage(ProgBarHwnd, PBM_SETBARCOLOR, 0, ByVal NewForeColor)

End Function


' Set the ProgressBar background color
Public Function ProgBarBackColor(ProgBarHwnd As Long, NewBackColor As Long)
    
    Call SendMessage(ProgBarHwnd, PBM_SETBKCOLOR, 0, ByVal NewBackColor)

End Function


' Return the size of a file, supports > 2 Gb too
Public Function GetFileSize(ByVal sFile As String, Optional ByRef sizelow As Long, Optional ByRef sizehigh As Long) As Currency
    
    Dim WFD As WIN32_FIND_DATA
    Dim hSearch As Long
    
    hSearch = FindFirstFile(sFile, WFD)
    FindClose hSearch
    sizelow = WFD.nFileSizeLow
    sizehigh = WFD.nFileSizeHigh
    GetFileSize = CCur(WFD.nFileSizeLow)
    If WFD.nFileSizeLow < 0 Then GetFileSize = GetFileSize + CCur(2 ^ 32)
    If WFD.nFileSizeHigh > 0 Then GetFileSize = GetFileSize + CCur(WFD.nFileSizeHigh) * CCur(2 ^ 32)
  
End Function


' Return the size of a file, supports > 2 Gb too, adding "Byte/KB/MB/GB" string
Public Function GetFileSizeStr(ByVal sFile As String, Optional Decimals As Long = 1) As String
    
    Dim FileSize As Currency
    
    FileSize = GetFileSize(sFile)
    If FileSize > 1000000000# Then
        GetFileSizeStr = Round(FileSize / 1024 / 1024 / 1024, Decimals) & " GB"
    ElseIf FileSize > 1000000# Then
        GetFileSizeStr = Round(FileSize / 1024 / 1024, Decimals) & " MB"
    ElseIf FileSize > 1000# Then
        GetFileSizeStr = Round(FileSize / 1024, Decimals) & " KB"
    Else
        GetFileSizeStr = Round(FileSize, Decimals) & " Byte"
    End If
  
End Function


' Return the size of the files from a dir, supports > 2 Gb too
Public Function GetDirSize(ByVal sDir As String, Optional sFilter As String = "*.*") As Currency

    Dim DirStr As String
    
    On Error GoTo Err_Handling
        
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    DirStr = Dir(sDir & sFilter)
    Do
        If DirStr <> "." And DirStr <> ".." Then
            GetDirSize = GetDirSize + GetFileSize(sDir & DirStr)
            DirStr = Dir
        End If
    Loop Until DirStr = ""
    
    Exit Function
    
Err_Handling:
GetDirSize = 0

End Function


' Pause program execution and wait for file existence
'  TimeIntervalSec [seconds]
Public Function WaitForFile(PathName As String, TimeIntervalSec As Long) As Long

    Dim TimeStart As Single
    
    TimeStart = Timer
    Do
    Loop Until Timer - TimeStart > TimeIntervalSec Or Dir(PathName) <> ""
    WaitForFile = Int(Timer - TimeStart)

End Function


' Return the process PID
' Return 0 if the process does not exist
Public Function FindRunningProcess(ProcessPathName As String) As Long

    Dim cb As Long
    Dim cbNeeded As Long
    Dim cbNeeded2 As Long
    Dim ProcessIDs() As Long
    Dim NumElements As Long
    Dim i As Long
    Dim hProcess As Long
    Dim lRet As Long
    Dim Modules(1 To 200) As Long
    Dim ModuleName As String
    
    On Error GoTo Err_Handling
    
    'Get the array containing the process id's for each process object
    cb = 8
    cbNeeded = 96
    Do While cb <= cbNeeded
       cb = cb * 2
       ReDim ProcessIDs(cb / 4) As Long
       lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
    Loop
    NumElements = cbNeeded / 4

    For i = 1 To NumElements
        'Get a handle to the Process
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcessIDs(i))
        'Got a Process handle
        If hProcess <> 0 Then
            'Get an array of the module handles for the specified process
            lRet = EnumProcessModules(hProcess, Modules(1), 200, cbNeeded2)
            'If the Module Array is retrieved, Get the ModuleFileName
            If lRet <> 0 Then
                ModuleName = Space(260)
                lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, 500)
                If Left(ModuleName, lRet) = ProcessPathName Then
                    FindRunningProcess = ProcessIDs(i)
                    Exit For
                End If
            End If
        End If
        'Close the handle to the process
        lRet = CloseHandle(hProcess)
    Next i
    
    Exit Function

Err_Handling:
FindRunningProcess = 0

End Function


' Kill process with ProcessPathName
Public Sub KillRunningProcess(ProcessPathName As String)

    Dim ProcessID As Long
    Dim hProc As Long
    
    ProcessID = FindRunningProcess(ProcessPathName)
    hProc = OpenProcess(PROCESS_TERMINATE, 0, ProcessID)
    If hProc <> 0 Then TerminateProcess hProc, 0
    CloseHandle hProc

End Sub


Public Sub OpenCD(driveLetter As String)

    Dim mssg As String * 255
    Dim ReturnValue As Long
    
    driveLetter = Left(driveLetter, 1) & ":\"
    ReturnValue = mciSendString("open " & driveLetter & _
        " Type cdaudio Alias cd", mssg, 255, 0)
    ReturnValue = mciSendString("set cd door open", _
        vbNullString, 0, 0)
    ReturnValue = mciSendString("close cd", 0&, 0, 0)

End Sub


