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 **************************************************

Leave a Reply

Your email address will not be published. Required fields are marked *