VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


'=============================================================================================================
'
' cFile Class Module
' ------------------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update : April 01, 2000
'
' VB Versions : 5.0 / 6.0
'
' Requires    : NOTHING
'
' Description : This class module was created to easily open or print a file... and even open the "Properties"
'               dialog for a file.  It also lets you open Windows Explorer to a specified directory.  This
'               class uses Windows API calls to do all this and includes full error checking for it.
'
' Example Use : ( See Below )
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


' SHELLEXECUTEINFO Mask Constants
Private Const SEE_MASK_CLASSKEY = &H3
Private Const SEE_MASK_CLASSNAME = &H1
Private Const SEE_MASK_CONNECTNETDRV = &H80
Private Const SEE_MASK_DOENVSUBST = &H200
Private Const SEE_MASK_FLAG_DDEWAIT = &H100
Private Const SEE_MASK_FLAG_NO_UI = &H400
Private Const SEE_MASK_HOTKEY = &H20
Private Const SEE_MASK_ICON = &H10
Private Const SEE_MASK_IDLIST = &H4
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40

' SHELLEXECUTEINFO Error Return Constants (.hInstApp)
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Const SE_ERR_ACCESSDENIED = 5
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_FNF = 2
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_OOM = 8
Private Const SE_ERR_PNF = 3
Private Const SE_ERR_SHARE = 26

' SHELLEXECUTEINFO Show Constants (.nShow)
Private Const SW_HIDE = 0
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_RESTORE = 9
Private Const SW_SHOW = 5
Private Const SW_SHOWDEFAULT = 10
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOWNORMAL = 1

' Type Declarations
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

' Variable Declarations
Private File_Handle As Long

' Function Declarations
Private Declare Function ShellExecuteEx Lib "SHELL32.DLL" (SEI As SHELLEXECUTEINFO) As Long
Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetLastError Lib "KERNEL32" () As Long

'_________________________________________________________________________________
'
' Returns the handle of the the instance handle of the application that was
' run, or the handle of a dynamic data exchange (DDE) server application
'_________________________________________________________________________________

Public Property Get fHandle() As Long
On Error Resume Next
  
  fHandle = File_Handle
  
End Property

'_________________________________________________________________________________
'
' Open the specified file with it's accociated application (ShellExecuteEx)
' =================================================================
'
' Usage Example(s):
' -----------------
' fOpen Me.hwnd, "ReadMe.txt", SW_SHOW
' fOpen Me.hwnd, "http://www.microsoft.com"
' fOpen Me.hwnd, "mailto:webmaster@microsoft.com"
'_________________________________________________________________________________

Public Function fOpen(OwnerhWnd As Long, FileName As String)
On Error Resume Next
  
  Dim SEI As SHELLEXECUTEINFO
  Dim ReturnValue As Long
  Dim TheError As Long
  
  With SEI
    .cbSize = Len(SEI)
    .fMask = SEE_MASK_IDLIST Or SEE_MASK_NOCLOSEPROCESS
    .hWnd = OwnerhWnd
    .lpVerb = "Open"
    .lpFile = FileName
    .lpParameters = vbNullChar
    .lpDirectory = vbNullChar
    .nShow = SW_SHOW
    .hInstApp = TheError
    .lpIDList = 0
  End With
  
  ReturnValue = ShellExecuteEx(SEI)
  ErrorMsg SEI.lpFile, SEI.hInstApp
  
End Function

'_________________________________________________________________________________
'
' Open the specified file with it's accociated application (ShellExecute)
' =================================================================
'
' Usage Example(s):
' -----------------
' fOpen_A Me.hwnd, "ReadMe.txt", SW_SHOW
' fOpen_A Me.hwnd, "NOTEPAD.EXE", SW_SHOW, "ReadMe.txt"
' fOpen_A Me.hwnd, "http://www.microsoft.com"
' fOpen_A Me.hwnd, "mailto:webmaster@microsoft.com"
'_________________________________________________________________________________

Public Function fOpen_A(OwnerhWnd As Long, FileName As String, Optional ShowStyle As Long = SW_SHOW, Optional CommandLine As String = vbNullString, Optional Directory As String = vbNullString)
On Error Resume Next
  
  Dim ReturnValue As Long
  
  ReturnValue = ShellExecute(OwnerhWnd, "open", FileName, CommandLine, Directory, ShowStyle)
  ErrorMsg_A ReturnValue, "open the file"
  
End Function

'_________________________________________________________________________________
'
' Print the specified file (ShellExecuteEx)
' =================================================================
'
' Usage Example(s):
' -----------------
' fPrint Me.hwnd, "ReadMe.txt"
'_________________________________________________________________________________

Public Function fPrint(OwnerhWnd As Long, FileName As String)
On Error Resume Next
  
  Dim SEI As SHELLEXECUTEINFO
  Dim ReturnValue As Long
  Dim TheError As Long
  
  With SEI
    .cbSize = Len(SEI)
    .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
    .hWnd = OwnerhWnd
    .lpVerb = "Print"
    .lpFile = FileName
    .lpParameters = vbNullChar
    .lpDirectory = vbNullChar
    .nShow = 0
    .hInstApp = TheError
    .lpIDList = 0
  End With
  
  ReturnValue = ShellExecuteEx(SEI)
  ErrorMsg SEI.lpFile, SEI.hInstApp
  
End Function

'_________________________________________________________________________________
'
' Print the specified file (ShellExecute)
' =================================================================
'
' Usage Example(s):
' -----------------
' fPrint_A Me.hwnd, "ReadMe.txt"
'_________________________________________________________________________________

Public Function fPrint_A(OwnerhWnd As Long, FileName As String, Optional Directory As String = vbNullString)
On Error Resume Next
  
  Dim ReturnValue As Long
  
  ReturnValue = ShellExecute(OwnerhWnd, "print", FileName, vbNullString, Directory, 0)
  ErrorMsg_A ReturnValue, "print the file"
  
End Function

'_________________________________________________________________________________
'
' Open "Windows Explorer" to the specified directory (ShellExecute)
' =================================================================
'
' Usage Example(s):
' -----------------
' fExplore Me.hwnd, "C:\Windows\System"
'_________________________________________________________________________________

Public Function fExplore(OwnerhWnd As Long, DirectoryPath As String)
On Error Resume Next
  
  Dim ReturnValue As Long
  
  ReturnValue = ShellExecute(OwnerhWnd, "explore", DirectoryPath, vbNullString, vbNullString, SW_SHOW)
  ErrorMsg_A ReturnValue, "explore the file"
  
End Function

'_________________________________________________________________________________
'
' Show properties window for the specified file (ShellExecuteEx)
' =================================================================
'
' Usage Example(s):
' -----------------
' fProperties Me.hwnd, "ReadMe.txt"
'_________________________________________________________________________________

Public Function fProperties(OwnerhWnd As Long, FileName As String)
On Error Resume Next
  
  Dim SEI As SHELLEXECUTEINFO
  Dim ReturnValue As Long
  Dim TheError As Long
  
  With SEI
    .cbSize = Len(SEI)
    .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
    .hWnd = OwnerhWnd
    .lpVerb = "Properties"
    .lpFile = FileName
    .lpParameters = vbNullChar
    .lpDirectory = vbNullChar
    .nShow = SW_SHOW
    .hInstApp = TheError
    .lpIDList = 0
  End With
  
  ReturnValue = ShellExecuteEx(SEI)
  ErrorMsg SEI.lpFile, SEI.hInstApp
  
End Function

'_________________________________________________________________________________
'
' This function checks to see if the [ShellExecuteEx] API returned an error in
' the SHELLEXECUTEINFO type.
'
'   * If it did, display an error message reporting it.
'   * If it didn't, record the handle of the application that was started.
'_________________________________________________________________________________

Private Function ErrorMsg(lpFile As String, hInstApp As Long, Optional Process As String = "")
On Error Resume Next
  
  Dim ErrMsg As String
  Dim NOERROR As Boolean
  
  Select Case hInstApp
    Case SE_ERR_ACCESSDENIED
      ErrMsg = "Access denied"
    Case SE_ERR_ASSOCINCOMPLETE
      ErrMsg = "File association information not complete"
    Case SE_ERR_DDEBUSY
      ErrMsg = "DDE operation busy"
    Case SE_ERR_DDEFAIL
      ErrMsg = "DDE operation failed"
    Case SE_ERR_DDETIMEOUT
      ErrMsg = "DDE operation timed out"
    Case SE_ERR_DLLNOTFOUND
      ErrMsg = "Dynamic-link library not found"
    Case SE_ERR_FNF
      ErrMsg = "File not found"
    Case SE_ERR_NOASSOC
      ErrMsg = "File association not available"
    Case SE_ERR_OOM
      ErrMsg = "Out of memory"
    Case SE_ERR_PNF
      ErrMsg = "Path not found"
    Case SE_ERR_SHARE
      ErrMsg = "Cannot share open file"
    Case Else
      NOERROR = True
      File_Handle = hInstApp
  End Select
  
  If NOERROR = False Then
    File_Handle = 0
    If Process = "" Then
      MsgBox lpFile & Chr(13) & Chr(13) & "The following error occured while trying to access/open this file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(hInstApp) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, "  File Access Error"
    Else
      MsgBox lpFile & Chr(13) & Chr(13) & "The following error occured while trying to " & Process & ":" & Chr(13) & Chr(13) & "Error Number = " & CStr(hInstApp) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, "  File Access Error"
    End If
  End If
  
End Function

'_________________________________________________________________________________
'
' This function checks to see if the [ShellExecute] API returned an error.
'
'   * If it did, display an error message reporting it.
'   * If it didn't, record the handle of the application that was started.
'_________________________________________________________________________________
Private Function ErrorMsg_A(ErrorNum As Long, Optional Process As String = "")
On Error Resume Next
  
  Dim ErrMsg As String
  Dim NOERROR As Boolean
  
  If ErrorNum < 33 Then
    Select Case ErrorNum
      Case 0
        ErrMsg = "The operating system is out of memory or resources."
      Case ERROR_FILE_NOT_FOUND
        ErrMsg = "The specified file was not found."
      Case ERROR_PATH_NOT_FOUND
        ErrMsg = "The specified path was not found."
      Case ERROR_BAD_FORMAT
        ErrMsg = "The .EXE file is invalid (non-Win32 .EXE or error in .EXE image)."
      Case SE_ERR_ACCESSDENIED
        ErrMsg = "The operating system denied access to the specified file."
      Case SE_ERR_ASSOCINCOMPLETE
        ErrMsg = "The filename association is incomplete or invalid."
      Case SE_ERR_DDEBUSY
        ErrMsg = "The DDE transaction could not be completed because other DDE transactions were being processed."
      Case SE_ERR_DDEFAIL
        ErrMsg = "The DDE transaction failed."
      Case SE_ERR_DDETIMEOUT
        ErrMsg = "The DDE transaction could not be completed because the request timed out."
      Case SE_ERR_DLLNOTFOUND
        ErrMsg = "The specified dynamic-link library was not found."
      Case SE_ERR_FNF
        ErrMsg = "The specified file was not found."
      Case SE_ERR_NOASSOC
        ErrMsg = "There is no application associated with the given filename extension."
      Case SE_ERR_OOM
        ErrMsg = "There was not enough memory to complete the operation."
      Case SE_ERR_PNF
        ErrMsg = "The specified path was not found."
      Case SE_ERR_SHARE
        ErrMsg = "A sharing violation occurred."
      Case Else
        ErrMsg = "Unknown Error"
    End Select
    File_Handle = 0
  Else
    NOERROR = True
    File_Handle = ErrorNum
  End If
  
  If NOERROR = False Then
    If Process = "" Then
      MsgBox "The following error was encountered while trying to access/open the file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(ErrorNum) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, "  Error Occured"
    Else
      MsgBox "The following error was encountered while trying to " & Process & ":" & Chr(13) & Chr(13) & "Error Number = " & CStr(ErrorNum) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, "  Error Occured"
    End If
  End If
  
End Function