Question

我试图让我的程序检查是实际连接的映射网络驱动器，并根据结果更改curDrive变量。它工作正常，但如果仍然映射驱动器并且驱动器不可用，则程序尝试连接时会有很长的延迟（4-6秒）。我尝试了两种方法，两种方式都有这种延迟。我尝试了以下方法：

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

我也尝试过：

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

两者都有相同的延迟。

Answer 1

两者都显示相同的延迟，因为两种方法都会调用相同的底层操作系统功能来检查是否存在网络驱动器。

操作系统正在为外部资源提供时间。如果你想肯定的话，我认为除了等待超时之外你什么也做不了。

如果您知道，在您的环境中操作系统超时太长（例如“如果它在1秒后没有响应，它将不响应），您可以使用诸如计时器之类的机制来避免等待完整持续时间（开始检查时设置1秒计时器，如果计时器触发但仍然没有回复，则驱动器不存在）。

Answer 2

使用FileSystemObject和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

Answer 3

经过大量的搜索和头脑风暴，我从这里和其他地方汇总了一些信息，并提出了一种需要半秒钟的方法。基本上，我正在ping服务器并从文本文件中读取结果。我还要检查以确保F：Drive（服务器驱动器）可用（有人可以在服务器上，但没有将F：Drive设置为服务器）。

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

检查映射网络是否可用

3 个答案: