我试图让我的程序检查是一个映射的网络驱动器实际上是连接的,并根据结果更改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
两者都有同样的延迟。
发布于 2014-07-09 15:52:48
经过大量的搜索和头脑风暴,我从这里和其他地方收集了一些信息,并想出了一个耗时半秒的方法。基本上,我在点击服务器并从文本文件中读取结果。我还在检查F:驱动器(服务器驱动器)是否可用(有人可以在服务器上,但尚未将F:驱动器设置为服务器)。
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
发布于 2014-07-03 20:12:46
两种方法都显示相同的延迟,因为这两种方法都调用相同的底层OS功能来检查网络驱动器的存在。
操作系统给出了可用的外部资源时间。我不认为你能做什么,除非等待超时,如果你想确定。
如果您知道,在您的环境中操作系统超时时间太长了。“如果它在1秒后没有响应,它将不会响应),您可以使用诸如计时器之类的机制来避免等待整个持续时间(当您开始检查时,设置一个1秒计时器,如果计时器触发,您仍然没有响应,驱动器就不存在)。
发布于 2014-07-03 20:59:45
使用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
https://stackoverflow.com/questions/24562491
复制相似问题