J
jason.vanbrackel
I have a VB6 Application that shells out some activity to another VB6
application in a separate thread. This second application relies
heavily upon the Microsoft Access 10.0 Object Library. I have also
used the Microsoft Access 11.0 Object Library. This second application
grabs recordsets from the Access mdb by using the below set of
commands.
Set qdfX = objAccess.CurrentDb.CreateQueryDef("", strSQLX)
Set rstX = qdfX.OpenRecordset()
I did not write this and I personally find this method of grabbing data
from Access to be a rather poor design choice, but it is entrenched
within the application, and it is unlikely that I can change it at this
point.
I believe the use of the automation in this manner may be causing the
application to freeze on some machines. It causes it and its parent
application to freeze as well. The rest of the machine continues to
run normally, and I have to kill the processes in Task Manager.
The second app is started from the first application with the code
below
ExecCmdLineEx """" & gstrDataManagerPath & "\" & DATA_MANAGER_EXE & """
-e[i2] -a[1]", SW_SHOWMINNOACTIVE, ABOVE_NORMAL_PRIORITY_CLASS
----ExecCmdLineEx Module----
Option Explicit
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 Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
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
String, _
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
String, _
lpStartupInfo As STARTUPINFO,
_
lpProcessInformation As
PROCESS_INFORMATION _
) As Long
Private Declare Function CloseHandle _
Lib "kernel32" ( _
ByVal hObject As Long _
) As Long
Private Declare Function GetExitCodeProcess _
Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long _
) As Long
Private Const INFINITE = -1&
'Show Window Constants
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
'End Show Window Constants
'Priority Class Constants
Private Const REALTIME_PRIORITY_CLASS = &H100&
Private Const HIGH_PRIORITY_CLASS = &H80&
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000&
Private Const IDLE_PRIORITY_CLASS = &H40&
'End Priority Class Constants
Public Function ExecCmdLineEx( _
szCommandLine, _
Optional nCmdShow As Variant, _
Optional dwPriorityCreationFlags As
Variant _
) As Long
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim lngReturnCode As Long
Const STARTF_USESHOWWINDOW = &H1
' Initialize the STARTUPINFO structure:
With start
.cb = Len(start)
'If this is missing then wShowWindow is ignored
.dwFlags = STARTF_USESHOWWINDOW
If (IsNull(nCmdShow)) Then
.wShowWindow = SW_SHOW
Else
.wShowWindow = nCmdShow
End If
End With
' Start the shelled application:
If IsNull(dwPriorityCreationFlags) Then
lngReturnCode = CreateProcessA(vbNullString, _
szCommandLine, _
0&, _
0&, _
1&, _
NORMAL_PRIORITY_CLASS, _
0&, _
vbNullString, _
start, _
proc _
)
Else
lngReturnCode = CreateProcessA(vbNullString, _
szCommandLine, _
0&, _
0&, _
1&, _
dwPriorityCreationFlags, _
0&, _
vbNullString, _
start, _
proc _
)
End If
' Wait for the shelled application to finish:
lngReturnCode = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, lngReturnCode)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmdLineEx = lngReturnCode
End Function
Any Ideas?
application in a separate thread. This second application relies
heavily upon the Microsoft Access 10.0 Object Library. I have also
used the Microsoft Access 11.0 Object Library. This second application
grabs recordsets from the Access mdb by using the below set of
commands.
Set qdfX = objAccess.CurrentDb.CreateQueryDef("", strSQLX)
Set rstX = qdfX.OpenRecordset()
I did not write this and I personally find this method of grabbing data
from Access to be a rather poor design choice, but it is entrenched
within the application, and it is unlikely that I can change it at this
point.
I believe the use of the automation in this manner may be causing the
application to freeze on some machines. It causes it and its parent
application to freeze as well. The rest of the machine continues to
run normally, and I have to kill the processes in Task Manager.
The second app is started from the first application with the code
below
ExecCmdLineEx """" & gstrDataManagerPath & "\" & DATA_MANAGER_EXE & """
-e[i2] -a[1]", SW_SHOWMINNOACTIVE, ABOVE_NORMAL_PRIORITY_CLASS
----ExecCmdLineEx Module----
Option Explicit
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 Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
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
String, _
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
String, _
lpStartupInfo As STARTUPINFO,
_
lpProcessInformation As
PROCESS_INFORMATION _
) As Long
Private Declare Function CloseHandle _
Lib "kernel32" ( _
ByVal hObject As Long _
) As Long
Private Declare Function GetExitCodeProcess _
Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long _
) As Long
Private Const INFINITE = -1&
'Show Window Constants
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
'End Show Window Constants
'Priority Class Constants
Private Const REALTIME_PRIORITY_CLASS = &H100&
Private Const HIGH_PRIORITY_CLASS = &H80&
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000&
Private Const IDLE_PRIORITY_CLASS = &H40&
'End Priority Class Constants
Public Function ExecCmdLineEx( _
szCommandLine, _
Optional nCmdShow As Variant, _
Optional dwPriorityCreationFlags As
Variant _
) As Long
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim lngReturnCode As Long
Const STARTF_USESHOWWINDOW = &H1
' Initialize the STARTUPINFO structure:
With start
.cb = Len(start)
'If this is missing then wShowWindow is ignored
.dwFlags = STARTF_USESHOWWINDOW
If (IsNull(nCmdShow)) Then
.wShowWindow = SW_SHOW
Else
.wShowWindow = nCmdShow
End If
End With
' Start the shelled application:
If IsNull(dwPriorityCreationFlags) Then
lngReturnCode = CreateProcessA(vbNullString, _
szCommandLine, _
0&, _
0&, _
1&, _
NORMAL_PRIORITY_CLASS, _
0&, _
vbNullString, _
start, _
proc _
)
Else
lngReturnCode = CreateProcessA(vbNullString, _
szCommandLine, _
0&, _
0&, _
1&, _
dwPriorityCreationFlags, _
0&, _
vbNullString, _
start, _
proc _
)
End If
' Wait for the shelled application to finish:
lngReturnCode = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, lngReturnCode)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmdLineEx = lngReturnCode
End Function
Any Ideas?