Check if mapped network available

问题

I am trying to have my program check is a mapped network drive is actually connected, and change the curDrive variable based on the result. It works okay, but if the drive is still mapped and the drive is not available, there is a long delay while the program tries to connect (4-6 seconds). I tried two methods and both ways have this delay. I tried the following:

    On Error GoTo switch
    checker= Dir("F:\")
    If checker= "" Then GoTo switch
         curDrive = "F:\"
    GoTo skip
switch:
    curDrive = "C:\"
skip:
 ........

I also tried:

Dim FSO As Object '//FileSystemObject
Dim f As Object '//File Object
Set FSO = CreateObject("Scripting.FileSystemObject")

With FSO
    If .FolderExists("F:\Sample") Then
        curDrive = "F:\"
    Else
        curDrive = "C:\"
    End If
End With

Both have the same delay.

回答1:

Both show the same delay because both methods invoke the same underlying OS functionality to check for the presence of the network drive.

The OS is giving the external resource time to be available. I don't think you can do anything except await the timeout, if you want to know for sure.

If you know that, in your environment the OS timeout is just too long (e.g. "If it has not responded after 1 second, it will not respond), you could use a mechanism such as a timer to avoid waiting the full duration (set a 1 second timer when you start checking, if the timer fires and you still have no reply, the drive was not present).

回答2:

There is no long delay when testing for a drive letter using the FileSystemObject and DriveExists:

Sub Tester()

    Dim n As Integer

    For n = 1 To 26
        Debug.Print Chr(64 + n), HaveDrive(Chr(64 + n))
    Next n

End Sub



Function HaveDrive(driveletter)
    HaveDrive = CreateObject("scripting.filesystemobject").driveexists(driveletter)
End Function

回答3:

After much searching and brainstorming, I put together some info from here and from elsewhere and came up with a method that takes half a second. Basically, I'm pinging the server and reading the results from a text file. I'm also checking to make sure that the F: Drive (the server drive) is available (Someone can be on the server but hasn't set the F: Drive to the server).

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long,   ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long

Sub CheckAllConnections()
    ServerOn = ComputerIsOnline("server.mmc.local")
    FDrive = CreateObject("scripting.filesystemobject").driveexists("F")
    test = FDrive - 1
    ProgramFolder = False
    If ServerOn + FDrive = -2 Then
        ProgramFolder = Len(Dir("F:\SampleProgram\")) > 0
    End If
    MsgBox ("Server connection is " & ServerOn & "." & Chr(10) & "F: Drive available is " & FDrive _
    & Chr(10) & "The Program Folder availability is " & ProgramFolder)
End Sub

Public Function ComputerIsOnline(ByVal strComputerName As String) As Boolean

On Error Resume Next
    Kill "C:\Logger.txt"
On Error GoTo ErrorHandler
    ShellX = Shell("cmd.exe /c ping -n 1 " & strComputerName & " > c:\logger.txt", vbHide)
    lPid = ShellX
    lHnd = OpenProcess(&H100000, 0, lPid)
    If lHnd <> 0 Then
        lRet = WaitForSingleObject(lHnd, &HFFFF)
        CloseHandle (lHnd)
    End If
        FileNum = FreeFile
        Open "c:\logger.txt" For Input As #FileNum
        strResult = Input(LOF(1), 1)
        Close #FileNum
        ComputerIsOnline = (InStr(strResult, "Lost = 0") > 0)
    Exit Function
ErrorHandler:
    ComputerIsOnline = False
    Exit Function
End Function

来源：https://stackoverflow.com/questions/24562491/check-if-mapped-network-available

标签

vba

vb6