I wrote the below pasted code and it worked for 295 times and never worked since. I don't think i did anything different. I tried using it on different computers/operating systems and it no longer works. Visual basic crashes when I run the code.
The code should get parameters from a text file and copy them to another textfile which is used as an input file for the software that I am using (HYDRUS2d). Then the code should execute hydrus2d, redirect input/output ( i needed to that because otherwise when hydrus2d ends, you need to hit enter on the dos window for hydrus2d to really end), copy the output file to another folder and repeat all these steps for the next set of parameters.
When I run the code, visual basic crashes but i do see that hydrus2d is still being executed when i check the processes in windows task manager.
Any suggestions why my code no longer works? I can't really debug it because it is copy/paste from different places. My visual basic knowledge is minimal.
Code:
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
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
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0
Private Function ExecuteApp(sCmdline As String) As String
Dim proc As PROCESS_INFORMATION, ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long 'The handle used to read from the pipe.
Dim hWritePipe As Long 'The pipe where StdOutput and StdErr will be sent.
Dim sOutput As String
Dim lngBytesRead As Long, sBuffer As String * 256
sa.nLength = Len(sa)
sa.bInheritHandle = True
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
Exit Function
End If
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
' Redirect the standard output and standard error to the same pipe
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
start.wShowWindow = SW_HIDE
' Start the shelled application
ret = CreateProcessA(0&, sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, _
0&, 0&, start, proc)
If ret = 0 Then
MsgBox "CreateProcess failed. Error: " & Err.LastDllError
Exit Function
End If
' The handle wWritePipe has been inherited by the shelled application
' so we can close it now
CloseHandle hWritePipe
' Read the characters that the shelled application
' has outputted 256 characters at a time
Do
ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
sOutput = sOutput & Left$(sBuffer, lngBytesRead)
Loop While ret <> 0 'if ret = 0 then there is no more characters to read
CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe
ExecuteApp = sOutput
End Function
Sub hydrus2dautomationwpipe()
Dim Textline
Dim cAction As String
Dim cfilename As String
Dim retval
Dim sayac As Long
sayac = 295
Open "C:\hydrus2d\defne\embankment1D\parametreler.txt" For Input As #2 ' Open file.
Do While Not EOF(2)
Line Input #2, Textline
Open "c:\hydrus2d\defne\embankment1D\selector.in" For Output As #1
Print #1, "Pcp_File_Version=2"
Print #1, "*** BLOCK A: BASIC INFORMATION *****************************************"
Print #1, "heading"
Print #1, "water flow in pavements"
Print #1, "LUnit TUnit MUnit (indicated units are obligatory for all input data)"
Print #1, "m"
Print #1, "days"
Print #1, "mmol"
Print #1, "Kat (0:horizontal plane, 1:axisymmetric vertical flow, 2:vertical plane)"
Print #1, "2"
Print #1, "MaxIt TolTh TolH InitH/W (max. number of iterations and tolerances)"
Print #1, " 20 0.001 0.1 f"
Print #1, "lWat lChem lSink Short Flux lScrn AtmIn lTemp lWTDep lEquil lExtGen lInv"
Print #1, " t f f t f f t f f f t t"
Print #1, "*** BLOCK B: MATERIAL INFORMATION **************************************"
Print #1, "NMat NLay hTab1 hTabN"
Print #1, " 1 1 1e-008 10000"
Print #1, " Model Hysteresis"
Print #1, " 0 0"
Print #1, " thr ths Alfa n Ks l"
Print #1, Textline
Print #1, "*** BLOCK C: TIME INFORMATION ******************************************"
Print #1, " dt dtMin dtMax DMul DMul2 ItMin ItMax MPL"
Print #1, " 0.001 1e-008 1 1.3 0.7 3 7 100"
Print #1, " tInit tMax"
Print #1, " 0 16"
Print #1, "TPrint(1),TPrint(2),...,TPrint(MPL)"
Print #1, " 0.16 0.32 0.48 0.64 0.8 0.96 "
Print #1, " 1.12 1.28 1.44 1.6 1.76 1.92 "
Print #1, " 2.08 2.24 2.4 2.56 2.72 2.88"
Print #1, " 3.04 3.2 3.36 3.52 3.68 3.84 "
Print #1, " 4 4.16 4.32 4.48 4.64 4.8 "
Print #1, " 4.96 5.12 5.28 5.44 5.6 5.76"
Print #1, " 5.92 6.08 6.24 6.4 6.56 6.72 "
Print #1, " 6.88 7.04 7.2 7.36 7.52 7.68 "
Print #1, " 7.84 8 8.16 8.32 8.48 8.64 "
Print #1, " 8.8 8.96 9.12 9.28 9.44 9.6 "
Print #1, " 9.76 9.92 10.08 10.24 10.4 10.56 "
Print #1, " 10.72 10.88 11.04 11.2 11.36 11.52 "
Print #1, " 11.68 11.84 12 12.16 12.32 12.48 "
Print #1, " 12.64 12.8 12.96 13.12 13.28 13.44 "
Print #1, " 13.6 13.76 13.92 14.08 14.24 14.4"
Print #1, " 14.56 14.72 14.88 15.04 15.2 15.36 "
Print #1, " 15.52 15.68 15.84 16 "
Print #1, "*** END OF INPUT FILE 'SELECTOR.IN' ************************************"
Close #1
sayac = sayac + 1
txtOutput = ExecuteApp("C:\hydrus2d\h2d_calc.exe" & " C:\hydrus2d\defne\embankment1D")
newname = "C:\hydrus2d\defne\outputs\" & sayac
Name "C:\hydrus2d\defne\embankment1D\Obsnod.out" As newname
Loop
Close #2 ' Close
End Sub
why does my code no longer work
Linear Mode
