msiShellAndWait and SHELL - need help!

Posted on 1998-07-26
Medium Priority
Last Modified: 2008-02-01
I  need a routine that shells to a program and waits till it's done to return to my VB application.
I really like     msiShellAndWait(ByVal CommandLine As String)     but it makes a
Windows Dos Box for DOS programs  (Works perfect for Win programs).

I don't want a Windows DOS box. I want it to drop to FULL SCREEN DOS like
you were at the prompt. This way when I launch a DOS program you can't tell
your in windows.
Key is, it has to be a routine that lets my program Know when the DOS app is done.

Anyway to make    msiShellAndWait(ByVal CommandLine As String)    work in
FULL SCREEN DOS ?  Or do I have to use another routine?
Question by:jgore
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 14

Accepted Solution

waty earned 200 total points
ID: 1466752
Here is code to do what you want

Option Explicit

Private Const MAX_FILENAME_LEN = 256

' File and Disk functions.
Public Const DRIVE_CDROM = 5
Public Const DRIVE_FIXED = 3
Public Const DRIVE_RAMDISK = 6
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_UNKNOWN = 0    'Unknown, or unable to be determined.

Private Declare Function GetDriveTypeA Lib "kernel32" (ByVal nDrive As String) As Long

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" _
   (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)

Private Declare Function GetWindowsDirectoryA Lib "kernel32" _
   (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetTempPathA Lib "kernel32" _
   (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const UNIQUE_NAME = &H0

Private Declare Function GetTempFileNameA Lib "kernel32" (ByVal _
   lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique _
   As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetSystemDirectoryA Lib "kernel32" _
   (ByVal lpBuffer As String, ByVal nSize As Long) 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 Const SW_HIDE = 0             ' = vbHide
Private Const SW_SHOWNORMAL = 1       ' = vbNormal
Private Const SW_SHOWMINIMIZED = 2    ' = vbMinimizeFocus
Private Const SW_SHOWMAXIMIZED = 3    ' = vbMaximizedFocus
Private Const SW_SHOWNOACTIVATE = 4   ' = vbNormalNoFocus
Private Const SW_MINIMIZE = 6         ' = vbMinimizedNofocus

Private Declare Function GetShortPathNameA Lib "kernel32" _
   (ByVal lpszLongPath As String, ByVal lpszShortPath _
   As String, ByVal cchBuffer As Long) As Long
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAborted As Boolean
        hNameMaps As Long
        sProgress As String
End Type

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_SILENT = &H4

Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
   "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadID As Long
End Type

Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000

Private Declare Function CloseHandle Lib "kernel32" (hObject As Long) As Boolean

Private Declare Function WaitForSingleObject Lib "kernel32" _
    (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" _
    (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, _
    ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function FindExecutableA Lib "shell32.dll" _
   (ByVal lpFile As String, ByVal lpdirectory As _
   String, ByVal lpResult As String) As Long

Private Declare Function SetVolumeLabelA Lib "kernel32" _
   (ByVal lpRootPathName As String, _
   ByVal lpVolumeName As String) As Long

'  Finds the executable associated with a file
'  Returns "" if no file is found.
Public Function FindExecutable(s As String) As String
   Dim i As Integer
   Dim s2 As String
   s2 = String(MAX_FILENAME_LEN, 32) & Chr$(0)
   i = FindExecutableA(s & Chr$(0), vbNullString, s2)
   If i > 32 Then
      FindExecutable = Left$(s2, InStr(s2, Chr$(0)) - 1)
      FindExecutable = ""
   End If
End Function

'  Deletes a single file, or an array of files to the trashcan.
Public Function ShellDelete(ParamArray vntFileName() As Variant) As Boolean
   Dim i As Integer
   Dim sFileNames As String

   For i = LBound(vntFileName) To UBound(vntFileName)
      sFileNames = sFileNames & vntFileName(i) & vbNullChar
   sFileNames = sFileNames & vbNullChar

   With SHFileOp
      .wFunc = FO_DELETE
      .pFrom = sFileNames
   End With

   i = SHFileOperation(SHFileOp)
   If i = 0 Then
      ShellDelete = True
      ShellDelete = False
   End If
End Function
'  Runs a command as the Shell command does but waits for the command
'  to finish before returning.  Note: The full path and filename extention
'  is required.
'  You might want to use Environ$("COMSPEC") & " /c " & command
'  if you wish to run it under the command shell (and thus it)
'  will search the path etc...
'  returns false if the shell failed
Public Function ShellWait(cCommandLine As String) As Boolean
    Dim NameStart As STARTUPINFO
    Dim i As Long

    NameStart.cb = Len(NameStart)
    i = CreateProcessA(0&, cCommandLine, 0&, 0&, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, NameStart, NameOfProc)
    If i <> 0 Then
       Call WaitForSingleObject(NameOfProc.hProcess, INFINITE)
       Call CloseHandle(NameOfProc.hProcess)
       ShellWait = True
       ShellWait = False
    End If
End Function

'  As the Execute function but waits for the process to finish before
'  returning
'  returns true on success.

Public Function ExecuteWait(s As String, Optional param As Variant) As Boolean
   Dim s2 As String
   s2 = FindExecutable(s)
   If s2 <> "" Then
      ExecuteWait = ShellWait(s2 & IIf(IsMissing(param), " ", " " & CStr(param) & " ") & s)
      ExecuteWait = False
   End If
End Function
'  Adds a backslash if the string doesn't have one already.
Public Function AddBackslash(s As String) As String
   If Len(s) > 0 Then
      If Right$(s, 1) <> "\" Then
         AddBackslash = s + "\"
         AddBackslash = s
      End If
      AddBackslash = "\"
   End If
End Function

' Executes a file with it's associated program.
'    windowstyle uses the same constants as the Shell function:
'       vbHide   0
'       vbNormalFocus  1
'       vbMinimizedFocus  2
'       vbMaximizedFocus  3
'       vbNormalNoFocus   4
'       vbMinimizedNoFocus   6
'   returns true on success
Public Function Execute(ByVal hwnd As Integer, s As String, Optional param As Variant, Optional windowstyle As Variant) As Boolean
   Dim i As Long
   If IsMissing(windowstyle) Then
      windowstyle = vbNormalFocus
   End If
   i = ShellExecute(hwnd, vbNullString, s, IIf(IsMissing(param) Or (param = ""), vbNullString, CStr(param)), GetPath(s), CLng(windowstyle))
   If i > 32 Then
      Execute = True
      Execute = False
   End If
End Function


Author Comment

ID: 1466753

Featured Post

[Webinar] How Hackers Steal Your Credentials

Do You Know How Hackers Steal Your Credentials? Join us and Skyport Systems to learn how hackers steal your credentials and why Active Directory must be secure to stop them.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses
Course of the Month9 days, 1 hour left to enroll

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question