Shell Command Duration

[fredlo2010]

Hello everyone,

I am working on a small code and I am trying to get the amount of time an specific shell command takes to execute. The command is to transfer a file from windows to our Linux server.

I need this because it could take some time to finish and I want to keep the users informed of the process more or less... its does not have to be exact is something to let them know more or less how much before the file is transferred.

This is my code. Where oLogin is an object with all the login information I need.


Public Sub SftpPut(ByVal oLogin As clsLogin, _ ByVal strFileName As String, _
ByVal strTempFileName As String)


Const strSFTP_EXECUTABLE As String = """C:\MACRO FOLDER\pscp.exe"""

Dim wSh As Object
Set wSh = VBA.CreateObject("WScript.Shell")


Dim strCommand As String
Dim strSFTPFile As String


strSFTPFile = oLogin.MainPath & "data/" & strFileName
strCommand = strSFTP_EXECUTABLE & _
" -sftp -p -l " & oLogin.User & _
" -pw " & oLogin.Password & _
" " & strTempFileName & " " & oLogin.Server & ":" & strSFTPFile


' Run command.
wSh.Run strCommand, 0, True

' Delete the temp file placed in N drive
Kill strTempFileName


' Add the file name to the final message
g_strFinalMessage = g_strFinalMessage & vbCr & strSFTPFile


' Clean up
Set oLogin = Nothing
Set wSh = Nothing

End Sub




Any ideas? Other than getting an average transfer rate and the use the file size to get an estimate I don't know what else. In average a long transfer will take 10 seconds when called three times in the same run(three files to be transferred) adds up. And user start clicking the application ... :)

Thanks a lot for the help.

[SamT]

How well do you know pscp.exe? If it sets any Environmental variables, you can loop a message until the variable is set.

Or check the process (PID) to see if it is running and exit the loop when it stops.

[fredlo2010]

Hi Sam,
As helpful as always. Yes that did the trick. I found this code online that finds the running processes and returns true or false. Warning it uses a lot of API's. http://www.vbforums.com/showthread.php?447184-Check-For-Running-Process


I modified the code to adapt to my needs. This is the code and the Main "IsProcessRunning" function

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, _
ByVal cb As Long, _
ByRef cbNeeded As Long) As Long

Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, _
ByRef lphModule As Long, _
ByVal cb As Long, _
ByRef lpcbNeeded As Long) As Long

Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFileName As String, _
ByVal nSize As Long) As Long

Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400

Function IsProcessRunning(ByVal sProcess As String) As Boolean

Const MAX_PATH As Long = 260

Dim lProcesses() As Long
Dim lModules() As Long
Dim N As Long
Dim lRet As Long
Dim hProcess As Long
Dim sName As String

sProcess = UCase$(sProcess)

ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then IsProcessRunning = True: Exit Function
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function

I created a small procedure to display the data and add some visual information (A small moving bar adds a lot of info)


Private Sub DisplayDataPush()
Const strMESSAGE_HEADLINE As String = "Sending data to server "
Dim iBars As Integer
Dim strMessage As String

iBars = 1
Do While IsProcessRunning("pscp.exe")
strMessage = strMESSAGE_HEADLINE & String$(CInt(iBars / 5), "|")

' Check for the StatusBar String Limit.
If Len(strMessage) > 250 Then
strMessage = Left$(strMessage, 250)
iBars = 1
End If

' Only display values ater 5 iterations so users can see it
If CInt(iBars / 5) <> 0 Then
Application.StatusBar = strMessage
End If

iBars = iBars + 1
Loop

End Sub

and finally the insertion in the original procedure


Public Sub SftpPut(ByVal oLogin As clsLogin, _ ByVal strFileName As String, _
ByVal strTempFileName As String)


Const strSFTP_EXECUTABLE As String = """C:\MACRO FOLDER\pscp.exe"""

Dim wSh As Object
Set wSh = VBA.CreateObject("WScript.Shell")


Dim strCommand As String
Dim strSFTPFile As String


strSFTPFile = oLogin.MainPath & "data/" & strFileName
strCommand = strSFTP_EXECUTABLE & _
" -sftp -p -l " & oLogin.User & _
" -pw " & oLogin.Password & _
" " & strTempFileName & " " & oLogin.Server & ":" & strSFTPFile

' Run command.
wSh.run strCommand, 0, False

' Keep the user Informed.
Call DisplayDataPush



' Delete the temp file placed in N drive
Kill strTempFileName


' Add the file name to the final message
g_strFinalMessage = g_strFinalMessage & vbCr & strSFTPFile


' Clean up
Set oLogin = Nothing
Set wSh = Nothing

End Sub


Thanks a lot Sam :)

[SamT]

:thumb

[snb]

Wouldn't this be an alternative:


Sub M_snb(ByVal oLogin As clsLogin, ByVal strFileName As String, ByVal strTempFileName As String)
CreateObject("WScript.Shell").exec "cmd /c ""C:\MACRO FOLDER\pscp.exe"" -sftp -p -l " & oLogin.user & "-pw " & oLogin.password & strTempFileName & " " & oLOgin.Server & ":data/" & strfilename
end sub

[Tommy]

Another version that worked well for me over the last 15+ years or so I think, I got this originally from the AllApi website.

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 NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$) As Long
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
'start.dwFlags = 1
'start.wShowWindow = vbHide
' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function

[fredlo2010]

Wouldn't this be an alternative:


Sub M_snb(ByVal oLogin As clsLogin, ByVal strFileName As String, ByVal strTempFileName As String)
CreateObject("WScript.Shell").exec "cmd /c ""C:\MACRO FOLDER\pscp.exe"" -sftp -p -l " & oLogin.user & "-pw " & oLogin.password & strTempFileName & " " & oLOgin.Server & ":data/" & strfilename
end sub

Hi snb,

I am not sure what as changed or how this will inform the user that there is something happening in the background. Can you help me understand?

Thanks

[fredlo2010]

Another version that worked well for me over the last 15+ years or so I think, I got this originally from the AllApi website.


Thank you Tommy, I will take a look at it but I am not sure how to use it for this situation. I might need to analyze it more.

[snb]

Sub M_snb(ByVal oLogin As clsLogin, ByVal strFileName As String, ByVal strTempFileName As String)
msgbox "Start the process and wait for the termination message"

CreateObject("WScript.Shell").exec "cmd /c ""C:\MACRO FOLDER\pscp.exe"" -sftp -p -l " & oLogin.user & "-pw " & oLogin.password & strTempFileName & " " & oLOgin.Server & ":data/" & strfilename

Msgbox "ready"
End Sub

[Tommy]

My version will not allow you to do anything else. So I am not sure it will work for this particular application. It starts a process and waits until it is done before it goes to the next step. I ran an automated mouse curser until it was done.

[fredlo2010]

Thanks Tommy,

It was not exactly the way I was looking for but it could work as well.

When the time is short I just use the third argument of the WScrip.shell Run method. In this case I have it set to false because I want to keep on moving to my loop-and-display-a moving-bar section.


wSh.run strCommand, 0, False

I have to say I am very happy with the effect. I know the Users will love it too. It will also stop it from clicking everywhere. If i ask myself the question "Are you done yet ?" and I know exactly whats's going on behind the scenes imagine the user. That's a call for " I need to keep the user informed in a way"

Thanks for the help Tommy. :)