Solved

Shell function

Posted on 1998-08-17
3
450 Views
Last Modified: 2010-04-30
I am trying to use the Shell function to start a program from another program running as a service under Windows NT. The program running as a service parses a text file into smaller pieces that the application it calls with the Shell function processes. When the called application finishes it writes a text file to the drive that the other program (service)waits for. After writing the text file it then quits. When the original program sees the text file it then parses out another chunk of text and starts the other program again. My problem is that I am getting two instances of the called program running at the same time and they end up stomping over each other. How do I get the called program to exit before the original program calls it up again?
0
Comment
Question by:dk02151
[X]
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
  • 2
3 Comments
 
LVL 9

Accepted Solution

by:
cymbolic earned 100 total points
ID: 1429317
Don't use the shell function, use a WIN32 createprocess call that reports on the completion of the shelled task:
0
 
LVL 9

Expert Comment

by:Dalin
ID: 1429318
' declaration, add to the general declaration area
          Const SYNCHRONIZE = &H100000
          Const INFINITE = &HFFFFFFFF
          Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As
          Long) As Long
          Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
          Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

 
' Using

          Dim pId As Long, pHnd As Long

          pId = Shell("YourApp", vbNormalFocus) '

          pHnd = OpenProcess(SYNCHRONIZE, 0, pId) '
          If pHnd <> 0 Then
              Call WaitForSingleObject(pHnd, INFINITE) '
               ' Wait for it to finish

              Call CloseHandle(pHnd)
          End If
0
 
LVL 9

Expert Comment

by:cymbolic
ID: 1429319
Like in the following:
Option Explicit
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFF           '  Infinite timeout
Private Const DEBUG_PROCESS = &H1
Private Const DEBUG_ONLY_THIS_PROCESS = &H2

Private Const CREATE_SUSPENDED = &H4

Private Const DETACHED_PROCESS = &H8

Private Const CREATE_NEW_CONSOLE = &H10

Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const REALTIME_PRIORITY_CLASS = &H100

Private Const CREATE_NEW_PROCESS_GROUP = &H200

Private Const CREATE_NO_WINDOW = &H8000000

Private Const WAIT_FAILED = -1&
Private Const WAIT_OBJECT_0 = 0
Private Const WAIT_ABANDONED = &H80&
Private Const WAIT_ABANDONED_0 = &H80&
Private Const WAIT_TIMEOUT = &H102&

Private Const SW_SHOW = 5

Private Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type

Private Const STARTF_USEPOSITION = &H4
Private Const STARTF_USESIZE = &H2

Private Type STARTUPINFO
        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

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessBynum Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Declare Function GetDOSName& Lib "kernel32" Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer _
As Long)

Declare Function FindExecutable& Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String)

Public goErr As New CError                  '// Error Class

Public gEn    As rdoEnvironment
Public gCnSrc$                              '// Source Database Path
Public gCnTgt As rdoConnection              '// Target Database
Public ErrLog$          'Error Log path/File
Public gTgtConnectString As String

Sub Main()

    On Error GoTo Main_Err
   
    Load FMigWiz
    FMigWiz.Show
    Exit Sub
   
Main_Err:
    errit "Main() Exception"
    Screen.MousePointer = vbDefault
End Sub
Public Sub errit(s$)
    With goErr
       .ErrNum = Err.Number
       .ErrDes = Err.Description
       .ErrSrc = Err.Source
       .Title = s$
       .DspErr
    End With
End Sub



Public Sub OpenTargetDb(dsn As String, dsnconnect As String)
'  Purpose: Opens the Migration Target database  (Pathways)
'  Created: 06/04/97 - Moved from InitDataSources()
' Modified: 08/19/97 - Joe: display mods.
'           08/25/97 - Joe: added registry store/retrieve functionality.
'----------------------------------------------------------------------------------------------
On Error GoTo OpenTargetDb_Err

If Len(dsn) > 0 Then
    Set gCnTgt = gEn.OpenConnection(dsn, rdDriverNoPrompt, False, dsnconnect)
End If

Exit Sub

OpenTargetDb_Err:
    errit "OpenTargetDb() Exception"
End Sub
Public Sub CreateProcess(prc$)
    Dim res&, ShellPgm$
    Dim sinfo As STARTUPINFO
    Dim pinfo As PROCESS_INFORMATION
    On Error GoTo prcerr
    sinfo.cb = Len(sinfo)
    sinfo.lpReserved = vbNullString
    sinfo.lpDesktop = vbNullString
    sinfo.lpTitle = vbNullString
    sinfo.dwFlags = 0
    ShellPgm$ = prc$ + Chr$(0)
    sinfo.dwFlags = STARTF_USEPOSITION + STARTF_USESIZE
    sinfo.dwX = 20 + FMigWiz.Left \ 14
    sinfo.dwY = 150 + FMigWiz.Top \ 14
    sinfo.dwXSize = FMigWiz.Width \ 14
    sinfo.dwYSize = (FMigWiz.Height \ 14) - 100
    res = CreateProcessBynum(vbNullString, ShellPgm$, 0, 0, True, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
    If res Then
     ' Let the process initialize
     Call WaitForInputIdle(pinfo.hProcess, INFINITE)
     ' We don't need the thread handle
     Call CloseHandle(pinfo.hThread)
     Do
        res = WaitForSingleObject(pinfo.hProcess, 0)
        If res <> WAIT_TIMEOUT Then
            ' No timeout, app is terminated
            Exit Do
        End If
        DoEvents
     Loop While True
     ' Kill the last handle of the process
     Call CloseHandle(pinfo.hProcess)
    End If
Exit Sub

prcerr:
 errit "Error Starting " + prc$
End Sub
Public Function DosName$(LongName$)
'Use api call to get short DOS Path/File Name
'Declare Function GetDOSName& Lib "kernel32" Alias "GetShortPathNameA" _
'(ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer _
'As Long)
Dim sn$, ln$
Dim cchb As Long
ln$ = LongName$ + Chr$(0)
sn$ = Space$(65)
cchb = 65
cchb = GetDOSName&(ln$, sn$, cchb)
DosName$ = Left$(sn$, cchb)
End Function
Public Function GetExePath$(Path$)
'uses following api to locate associated program path
'Declare Function FindExecutable& Lib "shell32.dll" Alias "FindExecutableA" _
'(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String)
Dim fil$
Dim dr$
Dim rslt$
Dim i As Integer
dr$ = Path$
i = Len(dr$)
While Mid$(dr$, i, 1) <> "\"
 i = i - 1
Wend
fil$ = Mid$(dr$, i + 1)
dr$ = Left$(dr$, i)
rslt$ = Space$(255) 'returned result
If FindExecutable&(fil$, dr$, rslt$) > 32 Then 'success
 i = InStr(rslt$, ".EXE")
 rslt$ = Left$(rslt$, i + 3)
 i = InStr(rslt$, Chr$(0))
 While i > 0
  rslt$ = Left$(rslt$, i - 1) + " " + Mid$(rslt$, i + 1)
  i = InStr(rslt$, Chr$(0))
 Wend
 GetExePath$ = DosName$(rslt$)
Else
 GetExePath$ = ""
End If
End Function

0

Featured Post

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

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

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
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 Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month10 days, 11 hours left to enroll

632 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