- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello all,
I've created a Compaq Visual Fortran 6.1 Console App that gets information from a SQL database using an ADO module created by the Fortran Module Wizard. It works great and we're very happy.
Unfortunately, when this console app is called from a Visual Basic 6 program using the CreateProcess function, it can't open the ADO connection or recordset. I get error number -2147352567 in my connection_open statement in Fortran. The app creates the connection object just fine.
Does anyone know what the difference is between calling this app from CreateProcess and running it as an EXE? I suspect its in the way CreateProcess is used, so I've attached my VB code below:
Dim lHndl As Long 'program handle
Dim udtProcInfo As PROCESS_INFORMATION 'process information for EXE
Dim udtStart As STARTUPINFO 'startup info for EXE
Dim udtSecurity As SECURITY_ATTRIBUTES 'security attributes for process
' and thread of EXE
Dim lInputEnd As Long 'position of the end of the input data
Dim lFileHndl As Long 'handle to error file
Dim lExit As Long 'termination status of EXE
Dim udtProcInfo As PROCESS_INFORMATION 'process information for EXE
Dim udtStart As STARTUPINFO 'startup info for EXE
Dim udtSecurity As SECURITY_ATTRIBUTES 'security attributes for process
' and thread of EXE
Dim lInputEnd As Long 'position of the end of the input data
Dim lFileHndl As Long 'handle to error file
Dim lExit As Long 'termination status of EXE
' open a file to catch errors
RtlZeroMemory udtSecurity, Len(udtSecurity)
udtSecurity.nLength = Len(udtSecurity)
udtSecurity.bInheritHandle = True
lFileHndl = CreateFile(sTempPath & sErrFile, FILE_WRITE_DATA, 0, _
udtSecurity, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
RtlZeroMemory udtSecurity, Len(udtSecurity)
udtSecurity.nLength = Len(udtSecurity)
udtSecurity.bInheritHandle = True
lFileHndl = CreateFile(sTempPath & sErrFile, FILE_WRITE_DATA, 0, _
udtSecurity, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
' Initialize the STARTUPINFO structure:
RtlZeroMemory udtStart, Len(udtStart)
udtStart.cb = Len(udtStart)
udtStart.dwFlags = STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES
udtStart.wShowWindow = SW_HIDE
udtStart.hStdOutput = lFileHndl
udtStart.hStdError = lFileHndl
RtlZeroMemory udtStart, Len(udtStart)
udtStart.cb = Len(udtStart)
udtStart.dwFlags = STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES
udtStart.wShowWindow = SW_HIDE
udtStart.hStdOutput = lFileHndl
udtStart.hStdError = lFileHndl
' Clear and re-Initialize the security attributes
RtlZeroMemory udtSecurity, Len(udtSecurity)
udtSecurity.nLength = Len(udtSecurity)
udtSecurity.bInheritHandle = True
RtlZeroMemory udtSecurity, Len(udtSecurity)
udtSecurity.nLength = Len(udtSecurity)
udtSecurity.bInheritHandle = True
' Start the shelled application:
lRet = CreateProcess(vbNullString, sEXEPath & sProgName & ".EXE", _
udtSecurity, udtSecurity, True, CREATE_NEW_CONSOLE + NORMAL_PRIORITY_CLASS, _
0, vbNullString, _
udtStart, udtProcInfo)
lRet = CreateProcess(vbNullString, sEXEPath & sProgName & ".EXE", _
udtSecurity, udtSecurity, True, CREATE_NEW_CONSOLE + NORMAL_PRIORITY_CLASS, _
0, vbNullString, _
udtStart, udtProcInfo)
' Wait for the shelled application to finish:
lRet = WaitForSingleObject(udtProcInfo.hProcess, 15000)
If lRet = WAIT_TIMEOUT Then
MsgBox "Program Abend - 15 second timeout limit exceeded. " & _
"Please reduce the number of data sets or contact CAE.", iMsgBox
lRet = CloseHandle(lHndl)
lHndl = OpenProcess(PROCESS_TERMINATE, 0, lShell)
If lHndl = 0 Then Exit Sub
lRet = TerminateProcess(lHndl, 0)
ElseIf lRet = WAIT_FAILED Then
MsgBox "Error Calling Program EXE - #" & Err.LastDllError & _
". Please contact CAE.", iMsgBox
GoTo RunProgErr
Else
'check normal/abnormal termination
lRet = GetExitCodeProcess(udtProcInfo.hProcess, lExit)
If lExit <> 0 Then _
MsgBox "An error occurred while attempting to run " & sProgName & _
" . Please examine your input data for errors.", iMsgBox
End If
lRet = CloseHandle(lHndl)
lRet = CloseHandle(lFileHndl)
lRet = WaitForSingleObject(udtProcInfo.hProcess, 15000)
If lRet = WAIT_TIMEOUT Then
MsgBox "Program Abend - 15 second timeout limit exceeded. " & _
"Please reduce the number of data sets or contact CAE.", iMsgBox
lRet = CloseHandle(lHndl)
lHndl = OpenProcess(PROCESS_TERMINATE, 0, lShell)
If lHndl = 0 Then Exit Sub
lRet = TerminateProcess(lHndl, 0)
ElseIf lRet = WAIT_FAILED Then
MsgBox "Error Calling Program EXE - #" & Err.LastDllError & _
". Please contact CAE.", iMsgBox
GoTo RunProgErr
Else
'check normal/abnormal termination
lRet = GetExitCodeProcess(udtProcInfo.hProcess, lExit)
If lExit <> 0 Then _
MsgBox "An error occurred while attempting to run " & sProgName & _
" . Please examine your input data for errors.", iMsgBox
End If
lRet = CloseHandle(lHndl)
lRet = CloseHandle(lFileHndl)
As always, many thanks in advance,
Robin
Link Copied
2 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The following sucessfully fires 'MagnifyingGlass.exe':
Option Explicit
'Process handle
Private id As Long
'API declares for starting, monitoring, and terminating a process
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Any, ByVal lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, StartInfo As STARTUPINFO, ProcessInfo As PROCESS_INFORMATION) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Requisite structures
Private Type STARTUPINFO '68 bytes
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
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
'dwCreation flags
Const CREATE_NEW_CONSOLE = &H10
Const CREATE_SEPARATE_WOW_VDM = &H800&
'dwStartupInfo flag
Const SW_NORMAL = 1
(In the Form_Load event)
'MagnifyingGlass
On Error Resume Next
Dim StartInfo As STARTUPINFO
Dim ProcessInfo As PROCESS_INFORMATION
Dim AppDir As String
Dim CommandLine As String
Dim r As Long
'Start it as a normal window
StartInfo.wShowWindow = SW_NORMAL
'Set size of structure
StartInfo.cb = Len(StartInfo)
'Run MagnifyingGlass - let OS find it
CommandLine = "MagnifyingGlass.exe"
'Start it
r = CreateProcess(vbNullString, CommandLine, 0&, 0&, 0&, 0&, CREATE_NEW_CONSOLE, vbNullString, StartInfo, ProcessInfo)
'Suspend thread some
Sleep (500&)
'Get process handle for terminating it
id = ProcessInfo.hProcess
'Close thread handle
r = CloseHandle(ProcessInfo.hThread)
(In the Form_Queryunload event)
If id <> 0 Then
Dim r As Long
'End it
r = TerminateProcess(id, 0&)
'Close process handle
r = CloseHandle(id)
End If
HTH,
Gerry T.
Option Explicit
'Process handle
Private id As Long
'API declares for starting, monitoring, and terminating a process
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Any, ByVal lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, StartInfo As STARTUPINFO, ProcessInfo As PROCESS_INFORMATION) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Requisite structures
Private Type STARTUPINFO '68 bytes
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
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
'dwCreation flags
Const CREATE_NEW_CONSOLE = &H10
Const CREATE_SEPARATE_WOW_VDM = &H800&
'dwStartupInfo flag
Const SW_NORMAL = 1
(In the Form_Load event)
'MagnifyingGlass
On Error Resume Next
Dim StartInfo As STARTUPINFO
Dim ProcessInfo As PROCESS_INFORMATION
Dim AppDir As String
Dim CommandLine As String
Dim r As Long
'Start it as a normal window
StartInfo.wShowWindow = SW_NORMAL
'Set size of structure
StartInfo.cb = Len(StartInfo)
'Run MagnifyingGlass - let OS find it
CommandLine = "MagnifyingGlass.exe"
'Start it
r = CreateProcess(vbNullString, CommandLine, 0&, 0&, 0&, 0&, CREATE_NEW_CONSOLE, vbNullString, StartInfo, ProcessInfo)
'Suspend thread some
Sleep (500&)
'Get process handle for terminating it
id = ProcessInfo.hProcess
'Close thread handle
r = CloseHandle(ProcessInfo.hThread)
(In the Form_Queryunload event)
If id <> 0 Then
Dim r As Long
'End it
r = TerminateProcess(id, 0&)
'Close process handle
r = CloseHandle(id)
End If
HTH,
Gerry T.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi Gerry,
Thanks for the help. My problem isn't that my console app won't start, though. It does - and behaves as expected -until we get to the ADO connections that don't work. They do if the console app is run directly as an EXE. So I'm asking if anyone knows why the console app would act differently when called from VB rather than run directly.
I'm starting to suspect that there is an issue with processes or something like that, but haven't had time to check it out.
Thanks,
Robin

Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page