VB6: как программно восстановить отключенные подключенные диски

Question

Моя программа VB6 использует данные, находящиеся в общем сетевом ресурсе.Win XP в беспроводной сети часто не может повторно подключить подключенные диски при запуске, поэтому они находятся в отключенном состоянии.Единственный способ восстановить их - дважды щелкнуть по ним в Проводнике.

Как это сделать программно?Есть ли вызов API, который это сделает?

Answer 1

Вы можете использовать функцию WNetAddConnection

Private Sub cmdMapDrive_Click()
Dim drive_letter As String
Dim share_name As String
Dim password As String

    lblResult.Caption = "Working..."
    Screen.MousePointer = vbHourglass
    DoEvents

    drive_letter = txtDriveLetter.Text
    If InStr(drive_letter, ":") = 0 _
        Then drive_letter = drive_letter & ":"
    share_name = txtShareName.Text
    password = txtPassword.Text

    If WNetAddConnection(share_name, password, _
        drive_letter) > 0 _
    Then
        lblResult.Caption = "Error mapping drive"
    Else
        lblResult.Caption = "Drive mapped"
    End If

    Screen.MousePointer = vbDefault
End Sub

Код Источник: VB Helper

Answer 2

Вы можете использовать команду dos "net use" и запустить ее с помощью команды shell из vb.

http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/net_use.mspx?mfr=true

Answer 3

Я сделал это с Scripting.FileSystemObject:

Public Function MapDrive(ByVal Sharename As String, DriveToMap As String) As Boolean

    On Error GoTo Handler

    Dim fso As Scripting.FileSystemObject
    Dim ntwk As IWshRuntimeLibrary.IWshNetwork_Class

    ' Assume success; any failure will invoke the error handler & cause '
    ' the function to return false. '
    MapDrive = True

    Set fso = New Scripting.FileSystemObject
    Set ntwk = New IWshRuntimeLibrary.IWshNetwork_Class

    ' If the specified drive doesn't even exist, just map it '
    If Not fso.DriveExists(DriveToMap) Then
        ntwk.MapNetworkDrive DriveToMap, Sharename
        Exit Function
    End If

    ' The drive already exists; see if it's already be mapped correctly. '
    If UCase(fso.Drives(DriveToMap).ShareName) = UCase(Sharename) Then
        Exit Function
    End If

    ' The drive is mapped, but to the wrong place. Unmap, then map the drive. '
    ntwk.RemoveNetworkDrive DriveToMap
    ntwk.MapNetworkDrive DriveToMap, Sharename
    Exit Function

Handler:
    MapDrive = False
    Err.Clear

End Function