VB6 : comment reconnecter par programme des lecteurs mappés déconnectés ?

Question

Mon programme VB6 repose sur des données se trouvant sur un partage réseau. Win XP sur un réseau sans fil ne peut souvent pas reconnecter les lecteurs mappés au démarrage, de sorte qu'ils sont dans un état déconnecté. La seule façon de les reconnecter est de double-cliquer dessus dans l'Explorateur.

Comment puis-je faire cela de manière programmatique ? Existe-t-il un appel d'API pour le faire ?

Answer 1

Vous pouvez utiliser le WNetAddConnection función

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

Code Source : Aide VB

Answer 2

Vous pouvez utiliser la commande dos " net use "et le faire démarrer avec l'option shell -commande de vb.

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

Answer 3

Je l'ai fait avec le 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