form1.frm

电子书“Visual Basic 6 网络编程实例教程.rar”

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "查找机器或共享资源"
   ClientHeight    =   2235
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4335
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2235
   ScaleWidth      =   4335
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "查找共享资源"
      Height          =   375
      Left            =   2520
      TabIndex        =   3
      Top             =   1560
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查找网络机器"
      Height          =   375
      Left            =   960
      TabIndex        =   2
      Top             =   1560
      Width           =   1455
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   960
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   960
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   960
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   360
      Width           =   3135
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "共享资源"
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   1080
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "网络机器"
      Height          =   180
      Left            =   120
      TabIndex        =   4
      Top             =   480
      Width           =   720
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub Command1_Click()
    Text1.Text = GetBrowseNetworkWorkstation()
End Sub

Private Sub Command2_Click()
    Text2.Text = GetBrowseNetworkShare()
End Sub

Private Function GetBrowseNetworkShare() As String
  '返回网络服务器或工作站中的有效的共享资源
   Dim BI As BROWSEINFO
   Dim pidl As Long
   Dim sPath As String
   Dim pos As Integer
  '获取指定的文件夹'network'的pidl
   If SHGetSpecialFolderLocation(Me.hWnd, _
                                 CSIDL_NETWORK, _
                                 pidl) = ERROR_SUCCESS Then
     '设置各成员的值，使得只能浏览网络文件夹的内容
      With BI
         .hOwner = Me.hWnd
         .pidlRoot = pidl
         .pszDisplayName = Space$(MAX_PATH)
         .lpszTitle = "选择一个网络计算机或共享资源"
         .ulFlags = BIF_RETURNONLYFSDIRS
      End With
         
     '显示浏览对话框
      pidl = SHBrowseForFolder(BI)
      If pidl <> 0 Then
         sPath = Space$(MAX_PATH)
         If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
           '如果pidl有效，则获取共享路径
            pos = InStr(sPath, Chr$(0))
            GetBrowseNetworkShare = Left$(sPath, pos - 1)
         End If
         Call CoTaskMemFree(pidl)
      Else:
        '选择了一个服务器
         GetBrowseNetworkShare = "\\" & BI.pszDisplayName
      End If  'If pidl
   End If  'If SHGetSpecialFolderLocation
End Function

Private Function GetBrowseNetworkWorkstation() As String
  '返回网络服务器或工作站
   Dim BI As BROWSEINFO
   Dim pidl As Long
   Dim sPath As String
   Dim pos As Integer
  '获取指定的文件夹'network'的pidl
   If SHGetSpecialFolderLocation(Me.hWnd, _
                                 CSIDL_NETWORK, _
                                 pidl) = ERROR_SUCCESS Then
     '设置各成员的值，使得只能浏览网络文件夹的内容
      With BI
         .hOwner = Me.hWnd
         .pidlRoot = pidl
         .pszDisplayName = Space$(MAX_PATH)
         .lpszTitle = "选择一个网络计算机"
         .ulFlags = BIF_BROWSEFORCOMPUTER
      End With
     '显示浏览对话框，因为此处不需要pidl，所以，可在此直接调用
      If SHBrowseForFolder(BI) <> 0 Then
         '用户选择了一个服务器。虽然也会返回一个有效的pidl，
         '但SHGetPathFromIDList只返回一个有效的文件系统对象的路径，
         '网络中的机器不是一个有效的文件系统对象。
          GetBrowseNetworkWorkstation = "\\" & BI.pszDisplayName
      End If  'If SHBrowseForFolder
      Call CoTaskMemFree(pidl)
   End If  'If SHGetSpecialFolderLocation
End Function