' 撰寫人：Devil(璉璉)  E-Mail: qvb3377@ms5.hinet.net  僅供學術測試使用，引用請註明原出處
' --------------------------------------------------------------------------------------
' 需要 include Window.bas
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 FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Private Const MAX_PATH = 260

Public Enum enulpOperation
   lpOperation_edit = 1
   lpOperation_explore = 2
   lpOperation_open = 3
   lpOperation_print = 4
   lpOperation_properties = 5
End Enum

Public Function myFindExecutable(ByVal lpFullFilename As String) As String

Dim lpResult As String
lpResult = String(MAX_PATH, 0)

lpFile = myGetSingleFileName(lpFullFilename)
lpDirectory = myGetPath(lpFullFilename)

summy = FindExecutable(lpFile, lpDirectory, lpResult)
myFindExecutable = Left(lpResult, InStr(lpResult, String(4, 0)) - 1)

End Function

Public Function myShellExecute(ByVal hWnd As Long, ByVal nOperation As enulpOperation, ByVal lpFile As String, Optional ByVal lpParameters As String, Optional ByVal lpDirectory As String, Optional ByVal nShowCmd As enuShowWindow = SW_SHOWNORMAL) As Long

Dim lpOperation As String
Select Case nOperation
Case Is = lpOperation_edit
   lpOperation = "edit"
Case Is = lpOperation_explore
   lpOperation = "explore"
Case Is = lpOperation_open
   lpOperation = "open"
Case Is = lpOperation_print
   lpOperation = "print"
Case Is = lpOperation_properties
   lpOperation = "properties"
Case Else
   lpOperation = ""
End Select

myShellExecute = ShellExecute(hWnd, lpOperation, lpFile, lpParameters, lpDirectory, nShowCmd)

End Function

Private Function GetWindowHandleLow(ByVal hWndStart As Long, hProcess As Long) As Long
   
Dim hWnd As Long
Dim hWndReturn As Long
Dim hProcessCur As Long
   
hWnd = GetWindow(hWndStart, GW_CHILD)
Do Until hWnd = 0
   GetWindowThreadProcessId hWnd, hProcessCur
   If hProcessCur = hProcess Then
      GetWindowHandleLow = hWnd
      Exit Function
   End If
   hWndReturn = GetWindowHandleLow(hWnd, hProcess)
   If hWndReturn <> 0 Then
      GetWindowHandleLow = hWndReturn
      Exit Function
   End If
   hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
GetWindowHandleLow = 0
   
End Function

Private Function GetWindowHandle(hProcess As Long) As Long

GetWindowHandle = GetWindowHandleLow(GetDesktopWindow, hProcess)

End Function

Public Function myShell(ByVal File As String, Optional ByVal CommandLine As Variant, Optional ByVal WorkPath As Variant, Optional ByVal WindowStyle As Long = vbNormalFocus, Optional ByVal Wait As Boolean = True)

Dim hProcessProgram As Long
Dim hWnd As Long

If Not IsMissing(WorkPath) Then
   OldPath = CurDir
   ChDir WorkPath
End If

If IsMissing(CommandLine) Then
   RunFilename = File
Else
   RunFilename = File + " " + CommandLine

End If

hProcessProgram = Shell(RunFilename, WindowStyle)

hWnd = GetWindowHandle(hProcessProgram)

If Wait Then
   Do
      summy = DoEvents()
   Loop Until IsWindow(hWnd) = 0

   hWnd = 0
End If

If Not IsMissing(WorkPath) Then
   ChDir OldPath
End If

If hWnd = 0 Then
   hWnd = FindWindowTitle(App.Title)
   ShowWindow hWnd, SW_SHOWNORMAL
   DoEvents
End If

myShell = hWnd

End Function

Public Function myDOSShell(ByVal File As String, Optional ByVal CommandLine As Variant, Optional ByVal WorkPath As Variant, Optional ByVal WindowStyle As Long = vbNormalFocus, Optional ByVal Wait As Boolean = True)

Dim hProcessProgram As Long
Dim hWnd As Long

If Not IsMissing(WorkPath) Then
   OldPath = CurDir
   ChDir WorkPath
End If

' 自動關閉 MS-DOS 視窗
If IsMissing(CommandLine) Then
   RunFilename = "command.com /c" + File
Else
   RunFilename = "command.com /c" + File + " " + CommandLine

End If

hProcessProgram = Shell(RunFilename, WindowStyle)

hWnd = GetWindowHandle(hProcessProgram)

If Wait Then
   Do
      summy = DoEvents()
   Loop Until IsWindow(hWnd) = 0

   hWnd = 0
End If

If Not IsMissing(WorkPath) Then
   ChDir OldPath
End If

If hWnd = 0 Then
   hWnd = FindWindowTitle(App.Title)
   ShowWindow hWnd, SW_SHOWNORMAL
   DoEvents
End If

myDOSShell = hWnd

End Function