PDA

View Full Version : سوال: ساخت Map Drive با VB



manmaaram
دوشنبه 16 دی 1392, 08:51 صبح
چطوری میشه با VB.net یک Map Network Drive ایجاد کرد

boveiryghasem
دوشنبه 16 دی 1392, 13:41 عصر
سلام
اول این رو توبرنامت امپورت کن:

Imports System.Runtime.InteropServices

بعدش با کدهای زیر میتونی MapDrive بسازی:

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Try
MapNetworkDrive("\\192.168.0.4\TCM\DT Requirements\Routes\KMLs", "R"c, False)
Catch ex As Exception
MessageBox.Show("The network drive could not be mapped for the following reason: " & ex.Message)
End Try
End Sub

Public Const NO_ERROR As UInteger = 0
Public Const RESOURCETYPE_DISK As UInteger = 1

<DllImportAttribute("mpr.dll", EntryPoint:="WNetAddConnection2W")> _
Public Shared Function WNetAddConnection2(ByRef lpNetResource As NETRESOURCE, <InAttribute(), MarshalAsAttribute(UnmanagedType.LPWStr)> ByVal lpPassword As String, <InAttribute(), MarshalAsAttribute(UnmanagedType.LPWStr)> ByVal lpUserName As String, ByVal dwFlags As UInteger) As UInteger
End Function

<StructLayoutAttribute(LayoutKind.Sequential)> _
Public Structure NETRESOURCE
Public dwScope As UInteger
Public dwType As UInteger
Public dwDisplayType As UInteger
Public dwUsage As UInteger
<MarshalAsAttribute(UnmanagedType.LPWStr)> _
Public lpLocalName As String
<MarshalAsAttribute(UnmanagedType.LPWStr)> _
Public lpRemoteName As String
<MarshalAsAttribute(UnmanagedType.LPWStr)> _
Public lpComment As String
<MarshalAsAttribute(UnmanagedType.LPWStr)> _
Public lpProvider As String
End Structure

Public Shared Sub MapNetworkDrive(ByVal UncPath As String, ByVal DriveLetter As Char, ByVal Persistent As Boolean, Optional ByVal ConnectionUsername As String = Nothing, Optional ByVal ConnectionPassword As String = Nothing)
If String.IsNullOrEmpty(UncPath) Then
Throw New ArgumentException("No UNC path specified", "UncPath")
End If
Dim DriveInfo As New NETRESOURCE
With DriveInfo
.dwType = RESOURCETYPE_DISK
.lpLocalName = DriveLetter & ":"
.lpRemoteName = UncPath
End With
Dim flags As UInteger = 0
If Persistent Then
flags = &H1
End If
Dim Result As UInteger = WNetAddConnection2(DriveInfo, ConnectionPassword, ConnectionUsername, flags)
If Not Result = NO_ERROR Then
Throw New System.ComponentModel.Win32Exception(CInt(Result))
End If
End Sub
فقط توی قسمت زیر از آدرس شیر شده خودت استفاده کن:

MapNetworkDrive("مسیر شیر شده", "R"c, False)