System commands in VB

[sagn]

Hi

This is probably a VERY basic question but,

how can I simply use a command such as

copy file lpr2

in VB. Where file is a string for the filename.
All I want to do is send the file to the line printer. This command works at the DOS
prompt. Also, I can execute it from Fortran.


I have tried Shell, but it would not work.
The I wrote a FOrtran program to print the file and asked VB to call it, using SHELL. That worked but only when I put
the file name in explicitly, ie not as a variable.


Again, in Fortran and in C I can do this easily using some sort of system call. How can I do the same with VB?

thanks

 

[johnwm]

I would use a batch file. With a text file called fred.bat in the root of C drive containing:
[tt]
c:
cdprint %1
[/tt]
You can call that from VB:
[tt]
Retval = shell("c:\fred.bat " & myFile)
[/tt]

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'If we're supposed to work in Hex, why have we only got A fingers?'

 

[Nagrom]

Here's some code I wrote for a class that you can add to your VB project. It will allow you to perform commands but with more flexibility than you get with the Shell command. Have fun.

==========================================================

' Force declaration of all variables
Option Explicit

' Declare APIs
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal lngProcessHandle As Long, lpExitCode As Long) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

' Declare constants
Private Const SW_SHOW = 5
Private Const MAX_PATH = 260
Private Const SE_ERR_FNF = 2
Private Const SE_ERR_OOM = 8
Private Const SE_ERR_PNF = 3
Private Const SW_SHOWNORMAL = 1
Private Const SE_ERR_SHARE = 26
Private Const STILL_ACTIVE = 259
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const PROCESS_VM_READ = 16
Private Const ERROR_BAD_FORMAT = 11
Private Const SE_ERR_DDETIMEOUT = 28
Private Const TH32CS_SNAPPROCESS = 2
Private Const SE_ERR_ACCESSDENIED = 5
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const ERROR_FILE_NOT_FOUND = 2
Private Const ERROR_PATH_NOT_FOUND = 3
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const PROCESS_QUERY_INFORMATION = 1024

' Declare Type variables
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

Public Function ExecuteAsynchronous(ByVal strProcess As String, _
Optional ByVal strProcessParameters As String = "", _
Optional ByVal strWorkDir As String = "", _
Optional ByVal constWindowStyle As VBA.VbAppWinStyle = vbNormalFocus, _
Optional ByVal lngTimeOutInSeconds As Long = 600, _
Optional ByRef strError As String = "") As Long

' Declare local variables
Dim lngTimeOut As Long
Dim lngLastError As Long
Dim lngTimeStart As Long
Dim lngProcessID As Long
Dim lngReturnValue As Long
Dim lngAPIExitCode As Long
Dim lngProcessHandle As Long
Dim lngCallReturnValue As Long
Dim lngProcessRetrievalAttempt As Long

' Initialize the return value and error message
lngReturnValue = 0
strError = ""

' Do not allow a timeout value of zero or less
If lngTimeOutInSeconds <= 0 Then
lngTimeOutInSeconds = 600
End If

' Convert timeout from seconds to milliseconds
lngTimeOut = lngTimeOutInSeconds * 1000

' Turn on manual error handling
On Error GoTo ExecuteAsynchronousError

' Call the ExecuteSynchronous function to kick off the process
lngCallReturnValue = ExecuteSynchronous(strProcess, strProcessParameters, strWorkDir, constWindowStyle, strError)

' Return the appropriate error message if OpenProcess failed, otherwise wait for
' the app to complete
If (lngCallReturnValue > 0) And (lngCallReturnValue <= 32) Then
' Retrieve the correct error message for the ShellExecute API call error
strError = SetShellExecuteErrorMessage(lngCallReturnValue)

' Set the error message if we don't already have error text from
' ExecuteSynchronous
If strError = "" Then
strError = "This program could not determine whether the process started. Please watch the program and check it completes."
End If
lngReturnValue = 1
Else
lngTimeStart = timeGetTime()
lngProcessRetrievalAttempt = 1
While lngProcessRetrievalAttempt < 9
lngProcessID = GetProcessID(strProcess)
If lngProcessID <> 0 Then
lngProcessRetrievalAttempt = 10
lngAPIExitCode = STILL_ACTIVE
lngProcessHandle = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lngProcessID)
While (lngAPIExitCode = STILL_ACTIVE) And (lngReturnValue = 0)
' Get the status of the process
If GetExitCodeProcess(lngProcessHandle, lngAPIExitCode) = 0 Then
'strError = "Attempt to verify application status failed."
strError = Err.Source & ": " & Err.LastDllError
lngReturnValue = 4
lngLastError = Err.LastDllError
End If

' Sleep during wait to ensure the other process gets
' processor slice:
DoEvents: Sleep 100
If (timeGetTime() - lngTimeStart > lngTimeOut) Then
' Too long!
strError = "The process has timed out."
lngReturnValue = 2
End If
Wend
Else
lngProcessRetrievalAttempt = lngProcessRetrievalAttempt + 1
DoEvents: Sleep 100
End If
Wend
If lngProcessRetrievalAttempt < 10 Then
strError = "Unable to locate ProcessID to verify application status."
lngReturnValue = 3
End If
End If

GoTo ExecuteAsynchronousComplete

ExecuteAsynchronousError:

lngReturnValue = Err.Number
strError = Err.Description
Err.Clear

ExecuteAsynchronousComplete:

' Return the API exit code
lngReturnValue = lngAPIExitCode

' Close the process handle
CloseHandle (lngProcessHandle)

' Turn off manual error handling
On Error GoTo 0

ExecuteAsynchronous = lngReturnValue

End Function

Public Function ExecuteSynchronous(ByVal strProcess As String, _
Optional ByVal strProcessParameters As String = "", _
Optional ByVal strWorkDir As String = "", _
Optional ByVal constWindowStyle As VBA.VbAppWinStyle = vbNormalFocus, _
Optional ByRef strError As String = "") As Long

' Declare variables
Dim lngShellReturn As Long

' Default working directory to current directory if one was not specified
If strWorkDir = "" Then
strWorkDir = CStr(CurDir)
End If

lngShellReturn = ShellExecute(0, vbNullString, strProcess, strProcessParameters, strWorkDir, constWindowStyle)

' Set the appropriate error message if shell execute failed, otherwise return
' success
If lngShellReturn >= 0 And _
lngShellReturn <= 32 Then
If lngShellReturn = 0 Then
lngShellReturn = 1
End If
strError = SetShellExecuteErrorMessage(lngShellReturn)
Else
lngShellReturn = 0
strError = ""
End If

' Return the value from the ShellExecute API call
ExecuteSynchronous = lngShellReturn

End Function

Private Function SetShellExecuteErrorMessage(lngErrNum As Long) As String

' Declare local variables
Dim strErr As String

' Initialize the return string
strErr = ""

' Return the appropriate error message string
Select Case lngErrNum
Case 0
strErr = "The operating system is out of memory or resources."
Case ERROR_FILE_NOT_FOUND
strErr = "The specified file was not found."
Case ERROR_PATH_NOT_FOUND
strErr = "The specified path was not found."
Case ERROR_BAD_FORMAT
strErr = "The .exe file is invalid (non-Win32® .exe or error in .exe image)."
Case SE_ERR_ACCESSDENIED
strErr = "The operating system denied access to the specified file. "
Case SE_ERR_ASSOCINCOMPLETE
strErr = "The file name association is incomplete or invalid."
Case SE_ERR_DDEBUSY
strErr = "The DDE transaction could not be completed because other DDE transactions were being processed."
Case SE_ERR_DDEFAIL
strErr = "The DDE transaction failed."
Case SE_ERR_DDETIMEOUT
strErr = "The DDE transaction could not be completed because the request timed out."
Case SE_ERR_DLLNOTFOUND
strErr = "The specified dynamic-link library was not found. "
Case SE_ERR_FNF
strErr = "The specified file was not found. "
Case SE_ERR_NOASSOC
strErr = "There is no application associated with the given file name extension. This error will also be returned if you attempt to print a file that is not printable."
Case SE_ERR_OOM
strErr = "There was not enough memory to complete the operation."
Case SE_ERR_PNF
strErr = "The specified path was not found."
Case SE_ERR_SHARE
strErr = "A sharing violation occurred."
End Select

SetShellExecuteErrorMessage = strErr

End Function

Private Function GetProcessID(ByVal strProcessName As String) As Long

' Declare variables
Dim lngSnapshot As Long
Dim strExtension As String
Dim lngMyProcessID As Long
Dim arrProcessName() As String
Dim boolProcessFound As Boolean
Dim pe32Process As PROCESSENTRY32

' Trim off the path portion of the process name
arrProcessName = Split(strProcessName, "\")
strProcessName = arrProcessName(UBound(arrProcessName))

' Format input variable to make later comparisons easier
strProcessName = UCase(Trim(strProcessName))

' If the process is not an executable file type, find the associated executable
strExtension = Right(strProcessName, 3)
If Not strExtension = "EXE" And _
Not strExtension = "COM" And _
Not strExtension = "BAT" Then
strProcessName = GetAssociatedExecutable(strExtension)
arrProcessName = Split(strProcessName, "\")
strProcessName = arrProcessName(UBound(arrProcessName))
strProcessName = UCase(Trim(strProcessName))
End If

' Get process id for this app
lngMyProcessID = GetCurrentProcessId

' Create snapshot of current processes
lngSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)

' Check if snapshot is valid
If lngSnapshot = -1 Then
GetProcessID = 0
Exit Function
End If

'Initialize pe32Process with correct size
pe32Process.dwSize = Len(pe32Process)

'Start looping through processes
boolProcessFound = ProcessFirst(lngSnapshot, pe32Process)
While boolProcessFound
If (pe32Process.th32ParentProcessID = lngMyProcessID) And _
(InStr(1, UCase(Trim(Replace(CStr(pe32Process.szExeFile), vbNullChar, ""))), strProcessName, vbTextCompare)) Then
GetProcessID = pe32Process.th32ProcessID
CloseHandle (lngSnapshot)
Exit Function
Else
boolProcessFound = ProcessNext(lngSnapshot, pe32Process)
End If
Wend

CloseHandle (lngSnapshot)

GetProcessID = 0

End Function

Public Function GetAssociatedExecutable(ByVal strExtension As String) As String

Dim strPath As String
Dim strFileName As String
Dim lngReturnValue As Long

'Create a tempfile
strPath = String$(MAX_PATH, 0)
If GetTempPath(MAX_PATH, strPath) Then
strFileName = String$(MAX_PATH, 0)
If GetTempFileName(strPath, "~", 0, strFileName) Then
strFileName = Left$(strFileName, InStr(strFileName, vbNullChar) - 1)

'Rename it to use supplied Extension
Name strFileName As Left$(strFileName, InStr(strFileName, ".")) & strExtension
strFileName = Left$(strFileName, InStr(strFileName, ".")) & strExtension

'Get name of associated EXE
strPath = String$(MAX_PATH, 0)
Call FindExecutable(strFileName, vbNullString, strPath)
GetAssociatedExecutable = Left$(strPath, InStr(strPath, vbNullChar) - 1)

'Clean up
Kill strFileName
Else
GetAssociatedExecutable = strExtension
End If
Else
GetAssociatedExecutable = strExtension
End If

End Function

 

[percent]

What system commands are you trying to run - the reason I ask is there is a vb equivalent command for each dos command

%, 2004