Tweet
Code:
'________________________________________________________________________________________
'
' Functions to handle network share authentication and mapped drives.
' Also includes short demo (in PBMAIN) and drive listing function.
' Code written for PB/WIN 9 and tested on Vista and Windows XP Pro+Home.
'
' THIS CODE IS NOT DESIGNED TO WORK ON WIN9X OR PRE-WIN2K SYSTEMS!
'
' Written by Kev Peel, 1st May 2009.
'________________________________________________________________________________________
#Compile Exe
#Register All
%USEMACROS = 1
#Include "win32api.inc"
'------------------------------------------------------------------------------
' Demonstrates connecting or reconnecting a mapped drive.
'------------------------------------------------------------------------------
Function PBMain
Local szShare As Asciiz * %MAX_PATH
Local szMapped As Asciiz * %MAX_PATH
Local nOption As Long
nOption = MessageBox(%NULL, "Do you want to map a new drive (YES) or use an existing drive (NO)?" + $CrLf + _
"Alternatively, press cancel to quit...", "MAPDRV", %MB_IconQuestion Or %MB_YesNoCancel)
If (nOption = %IdCancel) Then Exit Function
If (nOption = %IdYes) Then
' Map a new drive...
GetComputerName szShare, SizeOf(szShare)
szShare = InputBox$("Please enter the location of a network share to map (ie. [URL="file://workstation/c"]\\workstation\c[/URL])...", "MAPDRV", "\\" + szShare + "\c")
If Len(szShare) = 0 Then Exit Function
' OPTIONAL: Add new map location and/or user name and password...
netMapDrive(%NULL, szShare, "", "", "", %FALSE, szMapped)
' Open the mapped drive...
ShellExecute(0, "explore", szMapped, "", "", %SW_Show)
Else
' Reconnect to mapped drive...
szMapped = InputBox$("Please enter the mapped drive to reauthenticate...", "MAPDRV", "Z:")
If Len(szMapped) = 0 Then Exit Function
' OPTIONAL: Add user name and password...
netConnectShare(%NULL, szMapped, "", "", %FALSE)
End If
' Now show all connected drives...
Local sDrives As String
netListDrives(sDrives, %DRIVE_REMOTE)
MessageBox(%NULL, "Available network drives on system:" + $CrLf + $CrLf + sDrives, "MAPDRV", %MB_IconInformation)
If (nOption = %IdYes) Then
' Disconnect the newly mapped drive...
netDisconnect(szMapped)
End If
End Function
'------------------------------------------------------------------------------
' Connects to the specified shared network disk using the provided user name and password.
'
' hWnd is the parent for any dialogs shown. Can be NULL.
' szShare is the location of the network drive, including computer ([URL="file://computer/share"]\\computer\share[/URL])
' szUserName and szPassword are credentials for authentication.
' nRememberLogin can be TRUE to remember credentials.
'
' Note: if a mapped network drive is
' Returns TRUE on success.
'------------------------------------------------------------------------------
Function netConnectShare(ByVal hWnd As Dword, _
ByRef szShare As Asciiz, _
ByRef szUserName As Asciiz, _
ByRef szPassword As Asciiz, _
ByVal nRememberLogin As Long) As Long
Local tNetRes As NETRESOURCE
Local nRet As Long
' Initialize connection...
tNetRes.dwScope = %RESOURCE_GLOBALNET
tNetRes.dwType = %RESOURCETYPE_DISK
tNetRes.dwDisplayType = %RESOURCEDISPLAYTYPE_SHARE
tNetRes.dwUsage = %RESOURCEUSAGE_CONNECTABLE
' Remote or mapped?
If Left$(szShare, 2) = "\\" Then
' Remote drive...
tNetRes.lpRemoteName = VarPtr(szShare)
Else
' Mapped drive...
' Note: must obtain source share name.
Local szRemote As Asciiz * %MAX_PATH
If WNetGetConnection(szShare, szRemote, SizeOf(szRemote)) = %NO_ERROR Then
tNetRes.lpLocalName = VarPtr(szShare)
tNetRes.lpRemoteName = VarPtr(szRemote)
Else
' Failed to get mapped drive info...
Exit Function
End If
End If
nRet = WNetAddConnection3(hWnd, tNetRes, szPassword, szUsername, IIf&(nRememberLogin, %CONNECT_UPDATE_PROFILE, 0))
Function = IIf&(nRet = %NO_ERROR, %TRUE, %FALSE)
End Function
'------------------------------------------------------------------------------
' Maps a drive from the specified share. User name and password can also be specified.
'
' hWnd is the parent for any dialogs shown. Can be NULL.
' szShare is the location of the network drive, including computer ([URL="file://computer/share"]\\computer\share[/URL]).
' szDrive is the name for the mapped drive (ie. "Y:"). If not specified, a default drive is returned.
' szUserName and szPassword are credentials for authentication.
' nRememberLogin can be TRUE to remember credentials.
' szDriveOut (optional) is a buffer for the shared drive location if the default is used.
'
' Returns TRUE on success.
'------------------------------------------------------------------------------
Function netMapDrive(ByVal hWnd As Dword, _
ByRef szShare As Asciiz, _
ByRef szDrive As Asciiz, _
ByRef szUserName As Asciiz, _
ByRef szPassword As Asciiz, _
ByVal nRememberLogin As Long, _
Optional ByRef szDriveOut As Asciiz) As Long
Local tNetRes As NETRESOURCE
Local szBuf As Asciiz * %MAX_PATH
Local nRet As Long
' Initialize connection...
tNetRes.dwScope = %RESOURCE_GLOBALNET
tNetRes.dwType = %RESOURCETYPE_DISK
tNetRes.dwDisplayType = %RESOURCEDISPLAYTYPE_SHARE
tNetRes.dwUsage = %RESOURCEUSAGE_CONNECTABLE
tNetRes.lpLocalName = VarPtr(szDrive)
tNetRes.lpRemoteName = VarPtr(szShare)
nRet = WNetUseConnection(hWnd, tNetRes, szPassword, szUsername, %CONNECT_REDIRECT Or IIf&(nRememberLogin, %CONNECT_UPDATE_PROFILE, 0), szBuf, SizeOf(szBuf), nRet)
If (nRet = %NO_ERROR) Then
' Return drive if default name provided by Windows...
If Len(szDrive) = 0 Then szDriveOut = szBuf
' Success...
Function = %TRUE
End If
End Function
'------------------------------------------------------------------------------
' Disconnects a network share or unmaps the specified mapped network drive.
'
' szShare is the name of the share or mapped drive (ie. "Y:"). Must be specified.
' Note: the drive disconnection is forced.
'
' Returns TRUE on success.
'------------------------------------------------------------------------------
Function netDisconnect(ByRef szShare As Asciiz) As Long
' Very simple call...
Function = IIf&(WNetCancelConnection2(szShare, %CONNECT_UPDATE_PROFILE, %TRUE) = %NO_ERROR, %TRUE, %FALSE)
End Function
'------------------------------------------------------------------------------
' Lists all connected drives.
' nExclusiveType if specified, only returns drives of that type.
'------------------------------------------------------------------------------
Function netListDrives(ByRef sDrives As String, _
Optional ByVal nExclusiveType As Long) As Long
Local i As Long
Local n As Long
Local dwDrives As Dword
Local nType As Long
Local szType As Asciiz * 32
Reset sDrives
dwDrives = GetLogicalDrives
For i = 0 To 31
nType = GetDriveType(Chr$(65 + i) + ":")
' Exclusive drive types only...
If (nExclusiveType > 0) And (nType <> nExclusiveType) Then Iterate
Select Case Const nType
Case 1: Iterate ' Ignore it.
Case %DRIVE_REMOVABLE: szType = "Removable"
Case %DRIVE_FIXED: szType = "Fixed"
Case %DRIVE_REMOTE: szType = "Remote"
Case %DRIVE_CDROM: szType = "Optical"
Case %DRIVE_RAMDISK: szType = "Ram disk"
Case Else: szType = "Unknown"
End Select
If Bit(dwDrives, i) Then sDrives = sDrives + Chr$(65 + i) + ":" + " is " + szType + $CrLf
Incr n
Next i
' Return count...
Function = n
End Function
Comment