[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2085
  • Last Modified:

Execute DOS command in VB and wait for the end of the execution

I want to execute the following DOS command in VB6 to map a drive :

"net use m: \\myserver\mydrive ..."

BUT, I want my program do a pause to the end of the execution of this command.

If i use :

shell("net use m: \\myserver\mydrive ...")

It's not working cause the program don't wait for the end of the command and after this I have a code witch need to have the M drive mapped...

Thanks for your help !!

0
jenlain
Asked:
jenlain
4 Solutions
 
sokolovskyCommented:
Look at this code:

Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
End Enum
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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Private Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
End Enum
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Function RunAndWait(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
    Dim pclass As Long
    Dim sinfo As STARTUPINFO
    Dim pinfo As PROCESS_INFORMATION
    'Not used, but needed
    Dim sec1 As SECURITY_ATTRIBUTES
    Dim sec2 As SECURITY_ATTRIBUTES
    'Set the structure size
    sec1.nLength = Len(sec1)
    sec2.nLength = Len(sec2)
    sinfo.cb = Len(sinfo)
    'Set the flags
    sinfo.dwFlags = STARTF_USESHOWWINDOW
    'Set the window's startup position
    sinfo.wShowWindow = start_size
    'Set the priority class
    pclass = Priority_Class
    'Start the program
    If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, _
    0&, WorkDir, sinfo, pinfo) Then
        'Wait
        WaitForSingleObject pinfo.hProcess, dwMilliseconds
        RunAndWait = True
    Else
        RunAndWait = False
    End If
End Function
Private Sub Form_Load()
    Call RunAndWait("net use m: \\myserver\mydrive ...", "C:\", INFINITE, SW_HIDE, HIGH_PRIORITY_CLASS)
    MsgBox ("OK")
End Sub

0
 
___XXX_X_XXX___Commented:
Why you use DOS command ? You can use WNetAddConnection API to map a drive.
Some example from www.allapi.net:


Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
Const WN_SUCCESS = 0 ' The function was successful.
Const WN_NET_ERROR = 2 ' An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ' The password was invalid.
Function AddConnection(MyShareName As String, MyPWD As String, UseLetter As String) As Integer
    On Local Error GoTo AddConnection_Err
    AddConnection = WNetAddConnection(MyShareName, MyPWD, UseLetter)
AddConnection_End:
    Exit Function
AddConnection_Err:
    AddConnection = Err
    MsgBox Error$
    Resume AddConnection_End
End Function
Function CancelConnection(DriveLetter As String, Force As Integer) As Integer
    On Local Error GoTo CancelConnection_Err
    CancelConnection = WNetCancelConnection(DriveLetter, Force)
CancelConnection_End:
    Exit Function
CancelConnection_Err:
    CancelConnection = Err
    MsgBox Error$
    Resume CancelConnection_End
End Function
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net

    'to add a connection call by:
    variable = AddConnection("\\myserver\path","", "M:\")
MsgBox "Mapped"
    'To cancel a connection type:
    varible = CancelConnection("M:\",1)
MsgBox "Unmapped"
End Sub
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
p_sieCommented:
Use the ShellExecute API
0
 
pyromattCommented:
Rather than wait for the application to finish, why not wait until the drive becomes accessible? This way, you know that when the rest of your code is executed, the drive will definatly be existant. If, for whatever reason, the DOS command fails to map the drive and your code continues to run, your gonna get problems and errors kicking up.

Place this in a module:

'### START OF MODULE ###
Option Explicit

Public Enum DRIVE_STATUS
    DRIVE_DOESNT_EXIST = 1
    DRIVE_NOT_READY = 2
    DRIVE_READY = 3
End Enum

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Function DriveStatus(ByVal Drive As String) As DRIVE_STATUS

Dim lDriveType As Long, lFreeSpace As Long
Dim lSectorsPerCluster As Long, lBytesPerSector As Long
Dim lFreeClusters As Long, lTotalClusters As Long
Dim sDrive As String
sDrive = Drive

lDriveType = GetDriveType(sDrive)
If lDriveType = 1 Then
    DriveStatus = DRIVE_DOESNT_EXIST
Else
    lFreeSpace = GetDiskFreeSpace(sDrive, lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)
    DriveStatus = IIf(Err.LastDllError > 0, DRIVE_NOT_READY, DRIVE_READY)
End If

End Function
'###END OF MODULE###

Then after shelling your DOS command, place the following code:

'###START OF CODE###
Dim StartTime as Long
Dim TimeOut as Integer
StartTime = Timer
TimeOut = 8                                                    'Replace 8 with your desired timeout value (in seconds)

Do Until DriveStatus("M:\") = 3

 If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer +  86400) > (StartTime + Timeout)) Then

  Dim Response As VbMsgBoxResult
  Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")

  If Response = vbRetry Then
   StartTime = Timer
  Else
   End     'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
  End If

 End If

Loop
'###END OF CODE###

Should work. It will keep checking to see if the drive exists until it does exist (in which case your code continues after the loop,) or until it times out (in which case the a message box will appear asking whether the user wishes to retry and wait a little longer, or cancels and ends the application (or runs code that replaces 'End'.)
Even if you do use code that waits for the DOS command to complete, id still recommend this as it functions as a great lil error handler.  
0
 
pyromattCommented:
actually, you'll wanna replace that 2nd chunck of code with the following (fixed a couple of mini-bugs...)


'###START OF CODE###
Dim StartTime as Long
Dim TimeOut as Integer
StartTime = Timer
TimeOut = 8                                                    'Replace 8 with your desired timeout value (in seconds)

Do Until DriveStatus("M:\") = 3

 If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer +  86400) > (StartTime + Timeout)) Then

  Dim Response As VbMsgBoxResult
  Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")

  If Response = vbRetry Then
   StartTime = Timer
  Else
   End     'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
  End If

 End If

Loop
'###END OF CODE###


Thats a better version... tested n working :)
0
 
pyromattCommented:
ARGH! same code! i obviously havent quite woken up yet :S
sorry bout that... THIS is the working code!


'###START OF CODE###

Dim StartTime As Long
Dim TimeOut As Integer
StartTime = Timer - 1
TimeOut = 8                                                    'Replace 8 with your desired timeout value (in seconds)

Do Until DriveStatus("M:\") = 3

 If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer + 86400) > (StartTime + TimeOut)) Then

 Dim Response As VbMsgBoxResult
 Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")

  If Response = vbRetry Then
   StartTime = Timer - 1
  Else
   End     'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
  End If

 End If

 DoEvents

Loop
 
MsgBox "Drive present!"   'Only here for test puposes, can be removed on your finished app.

'###END OF CODE###

Thats better..........
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now