G
Guest
I need help with this script. The script is suppose to show remote users
mapped drive. I am not good with vbs scripts. Here the script. I copy from
web site then paste it into notepad. I get errors running it as a vbs.
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2005 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const NERR_SUCCESS As Long = 0&
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" _
Alias "WNetOpenEnumA" _
(ByVal dwScope As Long, _
ByVal dwType As Long, _
ByVal dwUsage As Long, _
lpNetResource As Any, _
lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" _
Alias "WNetEnumResourceA" _
(ByVal hEnum As Long, _
lpcCount As Long, _
lpBuffer As Any, _
lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" _
(ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" _
(ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Private Sub Form_Load()
Command1.Caption = "Enum Net Resources"
End Sub
Private Sub Command1_Click()
Dim hEnum As Long
Dim bufptr As Long
Dim dwBuffSize As Long
Dim nStructSize As Long
Dim dwEntries As Long
Dim success As Long
Dim cnt As Long
Dim netres() As NETRESOURCE
Dim sLocalName As String
Dim sUncName As String
List1.Clear
'obtain an enumeration handle that
'can be used in a subsequent call
'to WNetEnumResource
success = WNetOpenEnum(RESOURCE_CONNECTED, _
RESOURCETYPE_ANY, _
0&, _
ByVal 0&, _
hEnum)
'if no error and a handle obtained..
If success = NERR_SUCCESS And _
hEnum <> 0 Then
'set number of dwEntries and redim
'a NETRESOURCE array to hold the
'data returned
dwEntries = 1024
ReDim netres(0 To dwEntries - 1) As NETRESOURCE
'calculate the size of the buffer
'being passed
nStructSize = LenB(netres(0))
dwBuffSize = 1024& * nStructSize
'and call WNetEnumResource
success = WNetEnumResource(hEnum, _
dwEntries, _
netres(0), _
dwBuffSize)
If success = 0 Then
For cnt = 0 To dwEntries - 1
'clear the variables
sLocalName = ""
sUncName = ""
'Get the local name (drive letter) and
'strip null the trailing null
If netres(cnt).lpLocalName <> 0 Then
sLocalName = GetStrFromPtrA(netres(cnt).lpLocalName)
sLocalName = TrimNull(sLocalName)
End If
'Get the remote name (the UNC path)
'and strip null the trailing null
If netres(cnt).lpRemoteName <> 0 Then
sUncName = GetStrFromPtrA(netres(cnt).lpRemoteName)
sUncName = TrimNull(sUncName)
End If
'add item to the list
List1.AddItem sLocalName & vbTab & sUncName
Next cnt 'For cnt = 0
Else
List1.AddItem "WNetEnumResource error or no mapped drives"
End If 'If success = 0 (WNetEnumResource)
End If 'If success = 0 (WNetOpenEnum)
'clean up
Call WNetCloseEnum(hEnum)
End Sub
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlen(ByVal lpszA), 0)
Call lstrcpy(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
mapped drive. I am not good with vbs scripts. Here the script. I copy from
web site then paste it into notepad. I get errors running it as a vbs.
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2005 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const NERR_SUCCESS As Long = 0&
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" _
Alias "WNetOpenEnumA" _
(ByVal dwScope As Long, _
ByVal dwType As Long, _
ByVal dwUsage As Long, _
lpNetResource As Any, _
lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" _
Alias "WNetEnumResourceA" _
(ByVal hEnum As Long, _
lpcCount As Long, _
lpBuffer As Any, _
lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" _
(ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" _
(ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Private Sub Form_Load()
Command1.Caption = "Enum Net Resources"
End Sub
Private Sub Command1_Click()
Dim hEnum As Long
Dim bufptr As Long
Dim dwBuffSize As Long
Dim nStructSize As Long
Dim dwEntries As Long
Dim success As Long
Dim cnt As Long
Dim netres() As NETRESOURCE
Dim sLocalName As String
Dim sUncName As String
List1.Clear
'obtain an enumeration handle that
'can be used in a subsequent call
'to WNetEnumResource
success = WNetOpenEnum(RESOURCE_CONNECTED, _
RESOURCETYPE_ANY, _
0&, _
ByVal 0&, _
hEnum)
'if no error and a handle obtained..
If success = NERR_SUCCESS And _
hEnum <> 0 Then
'set number of dwEntries and redim
'a NETRESOURCE array to hold the
'data returned
dwEntries = 1024
ReDim netres(0 To dwEntries - 1) As NETRESOURCE
'calculate the size of the buffer
'being passed
nStructSize = LenB(netres(0))
dwBuffSize = 1024& * nStructSize
'and call WNetEnumResource
success = WNetEnumResource(hEnum, _
dwEntries, _
netres(0), _
dwBuffSize)
If success = 0 Then
For cnt = 0 To dwEntries - 1
'clear the variables
sLocalName = ""
sUncName = ""
'Get the local name (drive letter) and
'strip null the trailing null
If netres(cnt).lpLocalName <> 0 Then
sLocalName = GetStrFromPtrA(netres(cnt).lpLocalName)
sLocalName = TrimNull(sLocalName)
End If
'Get the remote name (the UNC path)
'and strip null the trailing null
If netres(cnt).lpRemoteName <> 0 Then
sUncName = GetStrFromPtrA(netres(cnt).lpRemoteName)
sUncName = TrimNull(sUncName)
End If
'add item to the list
List1.AddItem sLocalName & vbTab & sUncName
Next cnt 'For cnt = 0
Else
List1.AddItem "WNetEnumResource error or no mapped drives"
End If 'If success = 0 (WNetEnumResource)
End If 'If success = 0 (WNetOpenEnum)
'clean up
Call WNetCloseEnum(hEnum)
End Sub
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlen(ByVal lpszA), 0)
Call lstrcpy(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
