|
01-10-2004, 05:35 PM
|
#1 (permalink) |
|
Devils Cabana Boy
Location: Central Coast CA
|
visual basic and batch files
ok im trying to run a batch file with visual basic, basicly open up the batch file and let it do its thing
ive tried to use shell ("c:\1.bat") but it did not work it opend it but it does not run further id like to be able to run code as if it was enterd into the command prompt or from the run command any help is greatly apreciated.
__________________
Donate Blood! "Love is not finding the perfect person, but learning to see an imperfect person perfectly." -Sam Keen |
|
|
01-11-2004, 09:28 AM
|
#2 (permalink) |
|
Tilted
Location: Montana
|
here are a couple of links that have helped me
http://www.vbcode.com http://www.planet-source-code.com Good luck |
|
|
|
01-16-2004, 05:45 AM
|
#4 (permalink) |
|
Psycho
|
I wrote this class module some years ago. It's a bit long, and may do more than you want. Hopefully it will help or at least give you some idea on how to do it yourself.
Option Explicit 'Properties '----------- ' ShowWindow as integer (write-only) ' SW_HIDE = 0 ' SW_SHOWNORMAL = 1 ' SW_NORMAL = 1 ' SW_SHOWMINIMIZED = 2 ' SW_SHOWMAXIMIZED = 3 ' SW_MAXIMIZE = 3 ' SW_SHOWNOACTIVATE = 4 ' SW_SHOW = 5 ' SW_MINIMIZE = 6 ' SW_SHOWMINNOACTIVE = 7 ' SW_SHOWNA = 8 ' SW_RESTORE = 9 ' SW_SHOWDEFAULT = 10 ' SW_MAX = 10 ' LastError as string (read-only) Last error message ' LastErrorNumber as integer (read-only) Last error number ' 'Methods '----------- ' RunAndWaitForTerminate ' (Process As String) ' As Boolean ' Executes the specified process and waits for it to terminate. ' Returns true if successful, else sets LastError and LastErrorNumber. ' ' RunAndGetProccessId ' (Process as String, ProcessID as Long, ProcessHandle as Long) ' As Boolean ' Input: Process ' Ouput: ProcessID, ProcessHandle ' Executes the specified process and returns it's process id and handle ' Returns true if successful, else sets LastError and LastErrorNumber. ' ' CheckStillRunning ' (ProcessHandle as Long, StillRunning as Boolean) ' As Boolean ' Input: ProcessId ' Ouput: StillRunning ' StillRunning returns True if still running, returns False and closes handle ' if not running. ' Returns true if successful, else sets LastError and LastErrorNumber. ' ' CloseWindow ' (WindowHandle as Long) ' as Boolean ' Input: WindowHandle ' Returns true if successful, else sets LastError and LastErrorNumber. ' ' GetWindowHandleForProcessId ' (ProcessId as Long, WindowHandle as Long, Optional WindowTitle as String) ' as Boolean ' Input: ProcessId ' Ouput: WindowHandle, WindowTitle (optional) ' Returns true if successful, else sets LastError and LastErrorNumber. ' ' GetWindowHandleByTitle ' (WindowTitle as String, WindowHandle as Long, Optional MatchExact as Boolean) ' as Boolean ' Input: WindowTitle ' MatchExact - Only return window with exact match on WindowTitle, ' otherwise use sub-string match. ' Output: WindowHandle ' Returns true if successful, else sets LastError and LastErrorNumber. ' Note: Returns the 1st window that matches the WindowTitle. ' ' GetShortFileName ' (sLongFileName As String, sShortFileName As String) ' As Boolean ' Input: sLongFileName ' Output: sShortFileName ' Returns true if successful, else sets LastError and LastErrorNumber. ' ' SplitFileNameAndParams ' (sFilePathNameParams As String, sFilePathName As String, sParams As String) ' Input: sFilePathNameParams ' Output: sFilePathName ' sParams ' Private sLastError As String Private lLastError As Long 'API stuff Public Enum ShowWindow SW_HIDE = 0 SW_SHOWNORMAL = 1 SW_NORMAL = 1 SW_SHOWMINIMIZED = 2 SW_SHOWMAXIMIZED = 3 SW_MAXIMIZE = 3 SW_SHOWNOACTIVATE = 4 SW_SHOW = 5 SW_MINIMIZE = 6 SW_SHOWMINNOACTIVE = 7 SW_SHOWNA = 8 SW_RESTORE = 9 SW_SHOWDEFAULT = 10 SW_MAX = 10 End Enum Private Const STARTF_USESHOWWINDOW = &H1 Private Const SYNCHRONIZE = &H100000 Private Const INFINITE = &HFFFF ' Infinite timeout 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 Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type 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 myStartupInfo As STARTUPINFO 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 Private Declare Function GetLastError Lib "kernel32" () As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long Private Const GW_CHILD = 5 Private Const GW_HWNDFIRST = 0 Private Const GW_HWNDLAST = 1 Private Const GW_HWNDNEXT = 2 Private Const GW_HWNDPREV = 3 Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const WM_CLOSE = &H10 Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _ (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long 'FileSystemObject (scrrun.dll) Private fso As New Scripting.FileSystemObject Property Get LastError() As String LastError = sLastError End Property Property Get LastErrorNumber() As Long LastErrorNumber = lLastError End Property Property Let ShowWindow(ShowWindow As Integer) myStartupInfo.wShowWindow = ShowWindow End Property Public Function RunAndGetProcessId(Process As String, ProcessId As Long, ProcessHandle As Long) As Boolean Dim lRtnCode As Long Dim myProcessInfo As PROCESS_INFORMATION Dim sPathAndName As String Dim sParams As String Dim sTemp As String sLastError = "" lLastError = 0 On Error GoTo RunAndGetProcessIdError SplitFileNameAndParams Process, sPathAndName, sParams If sParams = "" Then sParams = vbNullString 'Make sure the process file path and name are specified as short names (8.3, no spaces) sTemp = sPathAndName GetShortFileName sTemp, sPathAndName 'Confirm process exists If Dir(sPathAndName) = "" Then 'Try again with .exe added If Dir(sPathAndName & ".exe") = "" Then lLastError = vbObjectError + 500 sLastError = "File Not Found [" & sPathAndName & "]" Exit Function Else sPathAndName = sPathAndName & ".exe" End If End If lRtnCode = CreateProcessBynum(vbNullString, sPathAndName & " " & sParams, 0, 0, True, _ NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, myStartupInfo, myProcessInfo) If lRtnCode = 0 Then 'Failure lLastError = GetLastError() sLastError = "CreateProcessBynum Error; Process [" & Process & "], Short Filename Process [" & sPathAndName & " " & sParams & "]" 'Just in case, close the process handle On Error Resume Next Call CloseHandle(myProcessInfo.hThread) Exit Function End If 'We don't need the thread handle Call CloseHandle(myProcessInfo.hThread) 'Return the processid and thread ProcessHandle = myProcessInfo.hProcess ProcessId = myProcessInfo.dwProcessId RunAndGetProcessId = True Exit Function RunAndGetProcessIdError: sLastError = Error$ lLastError = Err End Function Public Function CheckStillRunning(ProcessHandle As Long, StillRunning As Boolean) As Boolean Dim lRtnCode As Long sLastError = "" lLastError = 0 On Error GoTo StillRunningError 'Check if running lRtnCode = WaitForSingleObject(ProcessHandle, 0) If lRtnCode <> WAIT_TIMEOUT Then ' No timeout, app is terminated StillRunning = False ' Kill the last handle of the process Call CloseHandle(ProcessHandle) Else StillRunning = True End If CheckStillRunning = True Exit Function StillRunningError: sLastError = Error$ lLastError = Err End Function Public Function GetWindowHandleForProcessId(ProcessId As Long, WindowHandle As Long, _ Optional WindowTitle As String) As Boolean Dim lHwnd As Long Dim lThread As Long Dim lProcessId As Long Dim lTitleLen As Long Dim sTitle As String sLastError = "" lLastError = 0 On Error GoTo GetWindowHandleForProcessIdError 'The desktop is the highest window lHwnd = GetDesktopWindow() 'Its first child is the 1st top level window lHwnd = GetWindow(lHwnd, GW_CHILD) 'Search through all the windows Do While lHwnd <> 0 lThread = GetWindowThreadProcessId(lHwnd, lProcessId) If lProcessId = ProcessId Then 'MsgBox "Handle:" & lHwnd & " Thread:" & lThread & " ProcessId" & lProcessId WindowHandle = lHwnd Exit Do End If 'Get the next window lHwnd = GetNextWindow(lHwnd, GW_HWNDNEXT) Loop 'Did we find the window? If lHwnd <> 0 Then 'Get the window title If Not IsMissing(WindowTitle) Then lTitleLen = GetWindowTextLength(lHwnd) sTitle = String(lTitleLen + 1, " ") lTitleLen = GetWindowText(lHwnd, sTitle, lTitleLen + 1) WindowTitle = Left$(sTitle, lTitleLen) End If GetWindowHandleForProcessId = True Else sLastError = "No window handle found for ProcessId [" & ProcessId & "]" lLastError = vbObjectError + 501 End If Exit Function GetWindowHandleForProcessIdError: sLastError = Error$ lLastError = Err End Function Public Function CloseWindow(WindowHandle As Long) As Boolean Dim lRtnCode As Long sLastError = "" lLastError = 0 On Error GoTo CloseWindowError 'Post a message to the process to close lRtnCode = PostMessage(WindowHandle, WM_CLOSE, 0&, 0&) If lRtnCode = 0 Then 'Failure lLastError = GetLastError() sLastError = "PostMessage Error; WindowHandle [" & WindowHandle & "]" Exit Function End If CloseWindow = True Exit Function CloseWindowError: sLastError = Error$ lLastError = Err End Function Public Function RunAndWaitForTerminate(Process As String) As Boolean Dim lRtnCode As Long Dim myProcessInfo As PROCESS_INFORMATION Dim sPathAndName As String Dim sParams As String Dim sTemp As String sLastError = "" lLastError = 0 On Error GoTo RunAndWaitForTerminateError SplitFileNameAndParams Process, sPathAndName, sParams If sParams = "" Then sParams = vbNullString 'Make sure the process file path and name are specified as short names (8.3, no spaces) sTemp = sPathAndName GetShortFileName sTemp, sPathAndName 'Confirm process exists If Dir(sPathAndName) = "" Then 'Try again with .exe added If Dir(sPathAndName & ".exe") = "" Then lLastError = vbObjectError + 500 sLastError = "File Not Found [" & sPathAndName & "]" Exit Function Else sPathAndName = sPathAndName & ".exe" End If End If lRtnCode = CreateProcessBynum(vbNullString, sPathAndName & " " & sParams, 0, 0, True, _ NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, myStartupInfo, myProcessInfo) If lRtnCode Then If Not WaitForTerm(myProcessInfo) Then Exit Function Else lLastError = GetLastError() sLastError = "CreateProcessBynum Error; Process [" & Process & "], Short Filename Process [" & sPathAndName & " " & sParams & "]" 'Just in case, close the process handle On Error Resume Next Call CloseHandle(myProcessInfo.hThread) Exit Function End If RunAndWaitForTerminate = True Exit Function RunAndWaitForTerminateError: sLastError = Error$ lLastError = Err End Function Public Function GetWindowHandleByTitle(WindowTitle As String, WindowHandle As Long, _ Optional MatchExact As Boolean, Optional FullWindowTitle As String) As Boolean Dim lHwnd As Long Dim lTitleLen As Long Dim sTitle As String WindowHandle = 0 sLastError = "" lLastError = 0 On Error GoTo GetWindowHandleByTitleError 'The desktop is the highest window lHwnd = GetDesktopWindow() 'Its first child is the 1st top level window lHwnd = GetWindow(lHwnd, GW_CHILD) 'Search through all the windows Do While lHwnd <> 0 lTitleLen = GetWindowTextLength(lHwnd) sTitle = String(lTitleLen + 1, " ") 'Clear title buffer lTitleLen = GetWindowText(lHwnd, sTitle, lTitleLen + 1) sTitle = Left$(sTitle, lTitleLen) If MatchExact Then If LCase$(WindowTitle) = LCase$(sTitle) Then WindowHandle = lHwnd Exit Do End If Else If InStr(LCase$(sTitle), LCase$(WindowTitle)) > 0 Then WindowHandle = lHwnd If Not IsMissing(FullWindowTitle) Then FullWindowTitle = sTitle Exit Do End If End If 'Get the next window lHwnd = GetNextWindow(lHwnd, GW_HWNDNEXT) Loop 'Did we find the window? If WindowHandle <> 0 Then GetWindowHandleByTitle = True Else sLastError = "No window found for Window Title [" & WindowTitle & "]" lLastError = vbObjectError + 502 End If Exit Function GetWindowHandleByTitleError: sLastError = Error$ lLastError = Err End Function Private Function WaitForTerm(myProcessInfo As PROCESS_INFORMATION) As Boolean Dim lRtnCode As Long WaitForTerm = False On Error GoTo WaitForTermError 'Let the process initialize (This is only necessary if we were going 'to perform interprocess communication). Call WaitForInputIdle(myProcessInfo.hProcess, INFINITE) 'We don't need the thread handle Call CloseHandle(myProcessInfo.hThread) Do lRtnCode = WaitForSingleObject(myProcessInfo.hProcess, 0) If lRtnCode <> 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(myProcessInfo.hProcess) WaitForTerm = True Exit Function WaitForTermError: sLastError = Error$ lLastError = Err End Function Public Sub SplitFileNameAndParams(sFilePathNameParams As String, sFilePathName As String, sParams As String) 'The expected input is a run string which may contain 'command line parameters. This sub splits the File Path and Name from the Parameters 'Example; 'sFilePathNameParams= "c:\fund reporting\sungrd.bat 157 5/14/95" 'sFilePathName= "c:\fund reporting\sungrd.bat" 'sParams= "157 5/14/95" Dim sTrimmedProcess As String Dim nBackSlashIndex As Integer Dim nSpaceIndex As Integer Dim nSecondColenIndex As Integer Dim nSecondDblBackslashIndex As Integer Dim nSecondMarkerIndex As Integer Dim nIndex As Integer sTrimmedProcess = Trim$(sFilePathNameParams) If Len(sTrimmedProcess) < 3 Then Exit Sub 'Note: The function will not work if the file name has spaces (My File Name.exe) 'This can be very tricky; The file path and name may start with a drive letter 'and colen ( c: ), or may start with two backslashes (\\computer\server\...). 'Also, one or more parameters may be included which are also files (path and name). 'We need to find the first space after the last backslash but prior to a second colon 'or double backslash. 'Examples: 'c:\Program Files\myprog.exe -R c:\data\file.dat ' ^ 'c:\Program Files\myprog.exe -R \\comp1\data\file.dat ' ^ '\\comp1\Program Files\myprog.exe -R c:\data\file.dat ' ^ '\\comp1\Program Files\myprog.exe -R \\comp1\data\file.dat ' ^ 'Find the second colon (if any) nSecondColenIndex = InStr(3, sTrimmedProcess, ":") 'Find the second double backslash (if and) nSecondDblBackslashIndex = InStr(3, sTrimmedProcess, "\\") 'It's possible that one parameter has a path with a colen and another 'parameter has a path with double backslashes. Keep the first one. If nSecondColenIndex > 0 And nSecondDblBackslashIndex > 0 Then If nSecondColenIndex < nSecondDblBackslashIndex Then nSecondMarkerIndex = nSecondColenIndex Else nSecondMarkerIndex = nSecondDblBackslashIndex End If 'Otherwise, the parameters only have the same path type (if any at all) Else If nSecondColenIndex > 0 Then nSecondMarkerIndex = nSecondColenIndex ElseIf nSecondDblBackslashIndex > 0 Then nSecondMarkerIndex = nSecondDblBackslashIndex Else nSecondMarkerIndex = Len(sTrimmedProcess) + 1 End If End If If nSecondMarkerIndex = 3 Then Exit Sub 'Next find the last backslash prior to the second marker (colen or double backslash) nIndex = 2 Do nBackSlashIndex = nIndex nIndex = InStr(nIndex + 1, sTrimmedProcess, "\") Loop While nIndex > 0 And nIndex < nSecondMarkerIndex 'Now find the space between the file name and input parameters nSpaceIndex = InStr(nBackSlashIndex + 1, sTrimmedProcess, " ") If nSpaceIndex > 0 Then sFilePathName = Left$(sTrimmedProcess, nSpaceIndex - 1) sParams = Mid$(sTrimmedProcess, nSpaceIndex + 1) Else sFilePathName = sTrimmedProcess sParams = "" End If End Sub Public Function GetShortFileName(sLongFileName As String, sShortFileName As String) As Boolean 'Converts long path and file names into 8.3 format Dim FileObject As Scripting.File Dim sShortPath As String Dim sLongPath As String Dim nLen As Integer Dim nIndex As Integer Dim nBackSlashIndex As Integer Dim bFileObjectError As Boolean On Error GoTo ErrorTrap 'If any error occurs, we'll return a blank value sShortFileName = "" 'Use the FileObject to get the short file name. 'Note: The FileObject can only be used if the file has an extension. If InStr(sLongFileName, ".") > 0 Then On Error Resume Next Set FileObject = fso.GetFile(sLongFileName) If Err.Number <> 0 Then bFileObjectError = True Else sShortFileName = FileObject.ShortPath If Err.Number <> 0 Then bFileObjectError = True End If 'Close the FileObject Set FileObject = Nothing On Error GoTo ErrorTrap End If 'If the file does not have a file extension, then we cannot use the 'FileObject to get it's short path and name. Instead, 'we'll use a Windows API call (but GetShortPathName can only 'return the short path name). If InStr(sLongFileName, ".") = 0 Or bFileObjectError Then 'Unfortunatelly, the GetShortPathName function only works on paths without 'the filename. So we need to try and remove the file name. 'Find the last backslash. Do nBackSlashIndex = nIndex nIndex = InStr(nIndex + 1, sLongFileName, "\") Loop While nIndex > 0 If nBackSlashIndex = 0 Then Exit Function sLongPath = Left$(sLongFileName, nBackSlashIndex) sShortPath = String(255, " ") nLen = GetShortPathName(sLongPath, sShortPath, Len(sShortPath)) sShortFileName = Left$(sShortPath, nLen) & Mid$(sLongFileName, nBackSlashIndex + 1) End If GetShortFileName = True Exit Function ErrorTrap: sLastError = "GetShortFileName: " & Err.Description lLastError = Err.Number End Function Private Sub Class_Initialize() myStartupInfo.cb = Len(myStartupInfo) myStartupInfo.dwFlags = STARTF_USESHOWWINDOW myStartupInfo.wShowWindow = SW_SHOW End Sub Private Sub Class_Terminate() Set fso = Nothing End Sub |
|
|
| Tags |
| basic, batch, files, visual |
|
|
