Fundt på VBnet, det er måske noget.
http://vbnet.mvps.org/code/browse/browsenetwork.htmTo a project form add two command buttons (Command1, Command2), two text boxes (Text1, Text2), and two check boxes (Check1, Check2). Add the following code to the form:
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2004 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 NOERROR As Long = 0
Private Const MAX_PATH As Long = 260
Private Const CSIDL_NETWORK As Long = &H12
Private Const CSIDL_PRINTERS As Long = &H4
'For finding a folder to start document searching
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
'For starting the Find Computer
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
'Top of the dialog has 2 lines of text for
'BROWSEINFO.lpszTitle and one line if this flag is set.
'Passing the message BFFM_SETSTATUSTEXTA to the hwnd
'can set the rest of the text. This is not used with
'BIF_USENEWUI and BROWSEINFO.lpszTitle gets all three
'lines of text.
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
'Add an editbox to the dialog: SHELL 5.0 or later only!
Private Const BIF_EDITBOX As Long = &H10
'insist on valid result (or CANCEL)
Private Const BIF_VALIDATE As Long = &H20
'Use the new dialog layout with the ability
'to resize: SHELL 5.0 or later only!
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
'Allow URLs to be displayed or entered
'(Requires BIF_USENEWUI): SHELL 5.0 or later only!
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
'Add a UA hint to the dialog, in place of the
'edit box. May not be combined with BIF_EDITBOX: SHELL 6.0 or later only!
Private Const BIF_UAHINT As Long = &H100
'Do not add the "New Folder" button to the dialog.
'Only applicable with BIF_NEWDIALOGSTYLE: SHELL 5.0 or later only!
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
'Browsing for Computers
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
'Browsing for Printers
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
'Browsing for Everything
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
'sharable resources displayed (remote shares,
'requires BIF_USENEWUI): SHELL 5.0 or later only!
Private Const BIF_SHAREABLE As Long = &H8000&
Private Type BROWSEINFO 'bi
hOwner As Long
pidlRoot As Long
pszDisplayName As String 'return display name of item selected
lpszTitle As String 'text to go in the banner over the tree
ulFlags As Long 'flags that control the return stuff
lpfn As Long
lParam As Long 'extra info passed back in callbacks
iImage As Long 'output var: where to return the Image index
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Sub Form_Load()
Command1.Caption = "Get Network Workstation"
Command2.Caption = "Get Network Share"
Check1.Caption = "Use New UI"
Check2.Caption = "No 'New Folder' Button"
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub Command1_Click()
Dim bNewDialog As Boolean
Dim bNoNewFolder As Boolean
bNewDialog = Check1.Value = vbChecked '=True or False
bNoNewFolder = Check2.Value = vbChecked '=True or False
Text1.Text = GetBrowseNetworkWorkstation(Me.hWnd, bNewDialog, bNoNewFolder)
End Sub
Private Sub Command2_Click()
Dim bNewDialog As Boolean
Dim bNoNewFolder As Boolean
bNewDialog = Check1.Value = vbChecked
bNoNewFolder = Check2.Value = vbChecked
Text2.Text = GetBrowseNetworkShare(Me.hWnd, bNewDialog, bNoNewFolder)
End Sub
Private Function GetBrowseNetworkShare(hwndOwner As Long, _
bNewDialog As Boolean, _
bNoNewFolder As Boolean) As String
'returns only a valid share on a
'network server or workstation
Dim bi As BROWSEINFO
Dim pidl As Long
Dim spath As String
'obtain the pidl to the special folder 'network'
If SHGetSpecialFolderLocation(hwndOwner, _
CSIDL_NETWORK, _
pidl) = NOERROR Then
'fill in the required members, limiting the
'Browse to the network by specifying the
'returned pidl as pidlRoot
With bi
.hOwner = hwndOwner
.pidlRoot = pidl
.pszDisplayName = Space$(MAX_PATH)
.lpszTitle = "Select a network computer or share."
.ulFlags = BIF_RETURNONLYFSDIRS
If bNewDialog Then .ulFlags = .ulFlags Or BIF_NEWDIALOGSTYLE
If bNoNewFolder Then .ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON
End With
'show the browse dialog and return
'the PIDL for the selected folder
pidl = SHBrowseForFolder(bi)
If pidl <> 0 Then
'got a PIDL .. is it valid?
spath = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal spath) Then
'valid, so get the share path
GetBrowseNetworkShare = TrimNull(spath)
Else
'a server selected...follow same principle
'as in GetBrowseNetworkWorkstation
GetBrowseNetworkShare = "\\" & bi.pszDisplayName
End If 'If SHGetPathFromIDList
End If 'If pidl
Call CoTaskMemFree(pidl)
End If 'If SHGetSpecialFolderLocation
End Function
Private Function GetBrowseNetworkWorkstation(hwndOwner As Long, _
bNewDialog As Boolean, _
bNoNewFolder As Boolean) As String
'returns only a valid network server or
'workstation (does not display the shares)
Dim bi As BROWSEINFO
Dim pidl As Long
Dim spath As String
If SHGetSpecialFolderLocation(hwndOwner, _
CSIDL_NETWORK, _
pidl) = NOERROR Then
'fill in the required members
With bi
.hOwner = hwndOwner
.pidlRoot = pidl
.pszDisplayName = Space$(MAX_PATH)
.lpszTitle = "Select a network computer."
.ulFlags = BIF_BROWSEFORCOMPUTER
If bNewDialog Then .ulFlags = .ulFlags Or BIF_NEWDIALOGSTYLE
If bNoNewFolder Then .ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON
End With
pidl = SHBrowseForFolder(bi)
If pidl <> 0 Then
'a machine is selected. Although a valid pidl
'is returned, SHGetPathFromIDList only return
'paths to valid file system objects, of which
'a networked machine is not. However, the
'BROWSEINFO displayname member does contain
'the selected item, which we return
GetBrowseNetworkWorkstation = "\\" & bi.pszDisplayName
Call CoTaskMemFree(pidl)
End If 'If pidl
End If 'If SHGetSpecialFolderLocation
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function
Ny bruger
Nybegynder
Opret
Preview
