检查映射网络是否可用

问题描述

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

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:
 ........

我也试过:

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

两者都有相同的延迟.

推荐答案

经过大量的搜索和头脑风暴，我从这里和其他地方收集了一些信息，并想出了一个需要半秒钟的方法.基本上，我正在 ping 服务器并从文本文件中读取结果.我还在检查以确保 F: 驱动器(服务器驱动器)可用(有人可以在服务器上，但尚未将 F: 驱动器设置为服务器).

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

这篇关于检查映射网络是否可用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！