Option Compare Database
Option Explicit
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
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
Private Declare Function ShellExecuteEx Lib „shell32.dll“ Alias „ShellExecuteExA“ _
(lpExecInfo As SHELLEXECUTEINFO) As Boolean
Private Declare Function WaitForSingleObject Lib „kernel32“ _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const SEE_MASK_NOCLOSEPROCESS = &H40&
Private Const SEE_MASK_FLAG_NO_UI = &H400&
Private mProcessInfo As PROCESS_INFORMATION
Private mShellExecuteInfo As SHELLEXECUTEINFO
Private mProgName As String
Private mProgParas As String
Private mFile As String
Private mWorkDir As String
Private mError As Boolean
Private mShowErrors As Boolean
Private mWindowState As Long
Public Sub OpenFile()
mShellExecuteInfo.cbSize = Len(mShellExecuteInfo)
mShellExecuteInfo.fMask = SEE_MASK_NOCLOSEPROCESS + SEE_MASK_FLAG_NO_UI
mShellExecuteInfo.lpFile = mFile
mShellExecuteInfo.lpParameters = vbNullString
mShellExecuteInfo.lpDirectory = mWorkDir
mShellExecuteInfo.nShow = mWindowState ‚vbNormalFocus
mError = ShellExecuteEx(mShellExecuteInfo)
mProcessInfo.hProcess = mShellExecuteInfo.hProcess
mError = (mShellExecuteInfo.hInstApp < 32)
If mError And mShowErrors Then
MsgBox „clsShellExec: Die Datei »“ & mFile & „« konnte nicht geöffnet werden…“, vbOKOnly + vbExclamation, „!!! Problem !!!“
End If
End Sub
Public Property Let WindowState(lngWinState As Long)
mWindowState = lngWinState
End Property
Private Sub Class_Initialize()
mError = False ‚Kein Fehler
mShowErrors = True ‚Fehlermeldungen anzeigen
mWindowState = vbNormalFocus ‚Normales Fenster mit Focus
mWorkDir = „“ ‚Kein Arbeitsberzeichnis
End Sub
Public Property Let Parameters(strParas As String)
mProgParas = strParas
End Property
Public Property Let ShowError(bolFlag As Boolean)
mShowErrors = bolFlag
End Property
Public Sub RunAppl()
If mProgName <> „“ Then
mShellExecuteInfo.cbSize = Len(mShellExecuteInfo)
mShellExecuteInfo.fMask = SEE_MASK_NOCLOSEPROCESS + SEE_MASK_FLAG_NO_UI
mShellExecuteInfo.lpFile = mProgName
mShellExecuteInfo.lpParameters = mProgParas
mShellExecuteInfo.lpDirectory = mWorkDir
mShellExecuteInfo.nShow = mWindowState ‚vbNormalFocus
mError = ShellExecuteEx(mShellExecuteInfo)
mProcessInfo.hProcess = mShellExecuteInfo.hProcess
mError = (mShellExecuteInfo.hInstApp < 32)
If mError And mShowErrors Then
MsgBox „clsShellExec: Die Anwendung »“ & mProgName & „« konnte nicht geöffnet werden…“, vbOKOnly + vbExclamation, „!!! Problem !!!“
End If
Else
MsgBox „clsShellExec: Keine Anwendung spezifiziert!“, vbOKOnly + vbCritical, „!!! Problem !!!“
End If
End Sub
Public Property Get IsRunning() As Boolean
IsRunning = (WaitForSingleObject(mProcessInfo.hProcess, 10) <> 0)
End Property
Public Property Get Error() As Boolean
Error = mError
End Property
Public Property Let ProgramName(strProgName As String)
mProgName = strProgName
End Property
Public Property Let Filename(strFile As String)
mFile = strFile
End Property
Public Property Let WorkDir(strPath As String)
mWorkDir = strPath
End Property