Map Network Drive
Just want to share this. This has been with me for some time now and have used this in several applications in the past. Hope that someone will find this useful.
**************************************************
*-- Form: mapnet (d:\vfp_projects\mapnet.scx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 11/20/06 11:28:12 AM
*
Define Class mapnet As Form
Height = 108
Width = 469
DoCreate = .T.
AutoCenter = .T.
Caption = "Map Network Drive"
ControlBox = .F.
Closable = .F.
Name = "MapNet"
Add Object command2 As CommandButton With ;
Top = 48, ;
Left = 324, ;
Height = 23, ;
Width = 24, ;
FontBold = .T., ;
Caption = "...", ;
TabIndex = 5, ;
Name = "Command2"
Add Object combo1 As ComboBox With ;
Height = 24, ;
Left = 48, ;
Sorted = .T., ;
Style = 2, ;
TabIndex = 2, ;
Top = 12, ;
Width = 300, ;
Name = "Combo1"
Add Object label1 As Label With ;
AutoSize = .T., ;
Caption = "\<Drive", ;
Height = 17, ;
Left = 12, ;
Top = 17, ;
Width = 30, ;
TabIndex = 1, ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
Caption = "\<Path", ;
Height = 17, ;
Left = 12, ;
Top = 48, ;
Width = 27, ;
TabIndex = 3, ;
Name = "Label2"
Add Object text1 As TextBox With ;
Height = 23, ;
Left = 48, ;
TabIndex = 4, ;
Top = 48, ;
Width = 276, ;
Name = "Text1"
Add Object cmdmap As CommandButton With ;
Top = 12, ;
Left = 372, ;
Height = 27, ;
Width = 84, ;
Caption = "\<OK", ;
TabIndex = 6, ;
Name = "cmdMap"
Add Object cmdcancel As CommandButton With ;
Top = 48, ;
Left = 372, ;
Height = 27, ;
Width = 84, ;
Caption = "\<Cancel", ;
TabIndex = 7, ;
Name = "cmdCancel"
Add Object check1 As Checkbox With ;
Top = 84, ;
Left = 48, ;
Height = 17, ;
Width = 128, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "\<Reconnect at Logon", ;
Value = .T., ;
Name = "Check1"
Procedure getunc
* Program....: GetUNCPath.prg
* Version....: 1.0
* Author.....: Andrew Coates
* Date.......: September 28, 1998
* Notice.....: Copyright © 1998 Civil Solutions, All
* Rights Reserved.
* Compiler...: Visual FoxPro 05.00.00.0415 for Windows
* Abstract...: Wrapper to the API call that converts a
* mapped drive path to the UNC path
* Changes....:
* Originally used WNetGetUniversalName, but that
* doesn't work under Win95 (see KB Q131416). Now uses
* WNetGetConnection which uses a string rather than a
* structure so STRUCTURE_HEADER is now 0
Lparameters tcMappedPath, tnBufferSize
* from winnetwk.h
#Define UNIVERSAL_NAME_INFO_LEVEL 0x00000001
#Define REMOTE_NAME_INFO_LEVEL 0x00000002
* from winerror.h
#Define NO_ERROR 0
#Define ERROR_BAD_DEVICE 1200
#Define ERROR_CONNECTION_UNAVAIL 1201
#Define ERROR_EXTENDED_ERROR 1208
#Define ERROR_MORE_DATA 234
#Define ERROR_NOT_SUPPORTED 50
#Define ERROR_NO_NET_OR_BAD_PATH 1203
#Define ERROR_NO_NETWORK 1222
#Define ERROR_NOT_CONNECTED 2250
* local decision - paths are not likely to be longer
* than this - if they are, this function calls itself
* recursively with the appropriate buffer size as the
* second parameter
#Define MAX_BUFFER_SIZE 500
* string length at the beginning of the structure
* returned before the UNC path
* ACC changed to 0 on 9/10/98 - Now using
* WnetGetConnection which uses a string rather than a
* struct
#Define STRUCTURE_HEADER 0
Local lcReturnValue
If Type('tcMappedPath') = "C" And ! Isnull(tcMappedPath)
* split up the passed path to get just the drive
Local lcDrive, lcPath
* just take the first two characters - we'll put it
* all back together later. If the first two
* characters are not a valid drive, that's OK. The
* error value returned from the function call will
* handle it.
* case statement ensures we don't get the "cannot
* access beyond end of string" error
Do Case
Case Len(tcMappedPath) > 2
lcDrive = Left(tcMappedPath, 2)
lcPath = Substr(tcMappedPath, 3)
Case Len(tcMappedPath) <= 2
lcDrive = tcMappedPath
lcPath = ""
Endcase
Declare Integer WNetGetConnection In WIN32API ;
STRING @lpLocalPath, ;
STRING @lpBuffer, ;
INTEGER @lpBufferSize
* set up some variables so the appropriate call can
* be made
Local lcLocalPath, lcBuffer, lnBufferSize, ;
lnResult, lcStructureString
* set to +1 to allow for the null terminator
lnBufferSize = Iif(Pcount() = 1 Or Type('tnBufferSize') # "N" Or Isnull(tnBufferSize), ;
MAX_BUFFER_SIZE, ;
tnBufferSize) + 1
lcLocalPath = lcDrive
lcBuffer = Space(lnBufferSize)
* now call the dll function
lnResult = WNetGetConnection(@lcLocalPath, @lcBuffer, @lnBufferSize)
Do Case
* string translated sucessfully
Case lnResult = NO_ERROR
* Actually, this structure-stripping is no longer
* required because WnetGetConnection() returns a
* string rather than a struct
lcStructureString = Alltrim(Substr(lcBuffer, STRUCTURE_HEADER + 1))
lcReturnValue = Left(lcStructureString, ;
at(Chr(0), lcStructureString) - 1) + lcPath
* The string pointed to by lpLocalPath is invalid.
Case lnResult = ERROR_BAD_DEVICE
lcReturnValue = tcMappedPath
* There is no current connection to the remote
* device, but there is a remembered (persistent)
* connection to it.
Case lnResult = ERROR_CONNECTION_UNAVAIL
lcReturnValue = tcMappedPath
* A network-specific error occurred. Use the
* WNetGetLastError function to obtain a description
* of the error.
Case lnResult = ERROR_EXTENDED_ERROR
lcReturnValue = tcMappedPath
* The buffer pointed to by lpBuffer is too small.
* The function sets the variable pointed to by
* lpBufferSize to the required buffer size.
Case lnResult = ERROR_MORE_DATA
lcReturnValue = getuncpath(tcMappedPath, lnBufferSize)
* None of the providers recognized this local name
* as having a connection. However, the network is
* not available for at least one provider to whom
* the connection may belong.
Case lnResult = ERROR_NO_NET_OR_BAD_PATH
lcReturnValue = tcMappedPath
* There is no network present.
Case lnResult = ERROR_NO_NETWORK
lcReturnValue = tcMappedPath
* The device specified by lpLocalPath is not
* redirected.
Case lnResult = ERROR_NOT_CONNECTED
lcReturnValue = tcMappedPath
Otherwise
lcReturnValue = tcMappedPath
Endcase
Else
lcReturnValue = tcMappedPath
Endif
Return lcReturnValue
Endproc
Procedure Error
Lparameters nError, cMethod, nLine
Messagebox(Str(nError) + 'Please chose a valid network resource to map.',;
64,This.Caption)
Endproc
Procedure Init
Declare Integer WNetAddConnection In MPR.Dll String cNetPath, String;
cPassword, String cLocalName
Declare Integer WNetCancelConnection In MPR.Dll String cName, Long nForce
Declare Integer WNetGetConnection In WIN32API String cLocalName, String;
@cNetPath, Integer @nLen
Endproc
Procedure command2.Click
Local lcNetDrive
lcNetDrive = Getdir('','Select Network Resource',;
'Browse for Network Drive')
With This.Parent
lcNetDrive = .getunc(lcNetDrive)
.text1.Value = lcNetDrive
.text1.Refresh
Endwith
Endproc
Procedure combo1.Init
Local lnFirstDrv,lnLastDrv,lcDrive,lnCnt,lnDrvType
lnFirstDrv = Asc('A')
lnLastDrv = Asc('Z')
For lnCnt = lnFirstDrv To lnLastDrv
lcDrive = Chr(lnCnt) + ':'
lnDrvType = Drivetype(lcDrive)
Do Case
Case lnDrvType = 1 And lcDrive <> 'B:' && No type
This.AddItem(lcDrive)
Case lnDrvType = 2 && Floppy disk
Case lnDrvType = 3 && Hard disk
Case lnDrvType = 4 && Removable drive or network drive
*this.AddItem(lcDrive)
Case lnDrvType = 5 && CD-ROM
Case lnDrvType = 6 && RAM disk1
Endcase
Next
loWSHNet = Createobject('Wscript.Network')
loNetDrives = loWSHNet.EnumNetworkDrives
For lnX = 1 To loNetDrives.Count-1 Step 2
lcDrive = '\' + loNetDrives.Item(lnX-1) + ' ' + loNetDrives.Item(lnX)
This.AddItem(lcDrive)
Next
loWSHNet = .Null.
loNetDrives = .Null.
Endproc
Procedure cmdmap.Click
Local loWSHNet,lcDrive,lcPath,lnRetVal,lcMess,llReconnect
With This.Parent
lcDrive = Left(Alltrim(.combo1.Value),2)
lcPath = Alltrim(.text1.Value)
llReconnect = .check1.Value
If Empty(lcDrive) Or Isblank(lcDrive)
Messagebox('Please select Drive to map.',64,.Caption)
Return
Endif
If Empty(lcPath) Or Isblank(lcPath)
Messagebox('Please select Path.',64,.Caption)
Return
Endif
* lnRetVal = WNetAddConnection(lcPath,'',lcDrive)
loWSHNet = Createobject("Wscript.Network")
loWSHNet.MapNetworkDrive(lcDrive,lcPath,llReconnect)
loWSHNet = .Null.
.Release
Endwith
Endproc
Procedure cmdcancel.Click
Thisform.Release
Endproc
Enddefine
*
*-- EndDefine: mapnet
**************************************************