Solved

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

Posted on 2004-03-30
11
2,051 Views
Last Modified: 2007-12-19
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
Comment
Question by:jenlain
11 Comments
 
LVL 48

Accepted Solution

by:
Mikal613 earned 125 total points
Comment Utility
0
 
LVL 4

Assisted Solution

by:sokolovsky
sokolovsky earned 125 total points
Comment Utility
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
 
LVL 6

Assisted Solution

by:___XXX_X_XXX___
___XXX_X_XXX___ earned 125 total points
Comment Utility
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
 
LVL 9

Expert Comment

by:p_sie
Comment Utility
Use the ShellExecute API
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Expert Comment

by:pyromatt
Comment Utility
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
 

Assisted Solution

by:pyromatt
pyromatt earned 125 total points
Comment Utility
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
 

Expert Comment

by:pyromatt
Comment Utility
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
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now