form1.frm

来自「电子书“Visual Basic 6 网络编程实例教程.rar”」· FRM 代码 · 共 108 行

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "网络资源"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   2040
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   4455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "运行(&R)"
      Default         =   -1  'True
      Height          =   495
      Left            =   1680
      TabIndex        =   0
      Top             =   2640
      Width           =   1215
   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()
    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
  '获取枚举句柄，该句柄可用于调用函数WNetEnumResource
   success = WNetOpenEnum(RESOURCE_CONNECTED, _
                          RESOURCETYPE_ANY, _
                          0&, _
                          ByVal 0&, _
                          hEnum)
  '如果成功获得枚举句柄
   If success = NERR_SUCCESS And _
      hEnum <> 0 Then
     '设置dwEntries的值，并重定义NETRESOURCE数组，以能存放数据
      dwEntries = 1024
      ReDim netres(0 To dwEntries - 1) As NetResource
     '计算要传递给函数的缓存的大小
      nStructSize = LenB(netres(0))
      dwBuffSize = 1024& * nStructSize
     '调用WNetEnumResource
      success = WNetEnumResource(hEnum, _
                                 dwEntries, _
                                 netres(0), _
                                 dwBuffSize)
      If success = 0 Then
         For cnt = 0 To dwEntries - 1
           '初始化变量
            sLocalName = ""
            sUncName = ""
           '获取本地名，并删除结尾的空字符
            If netres(cnt).lpLocalName <> 0 Then
               sLocalName = GetStrFromPtrA(netres(cnt).lpLocalName)
               sLocalName = TrimNull(sLocalName)
            End If
           '获取远程名(UNC路径)，并删除结尾的空字符
            If netres(cnt).lpRemoteName <> 0 Then
               sUncName = GetStrFromPtrA(netres(cnt).lpRemoteName)
               sUncName = TrimNull(sUncName)
            End If
           '将机器名添加到列表框中
            List1.AddItem sLocalName & vbTab & sUncName
         Next cnt  'For cnt = 0
      Else
         List1.AddItem "WNetEnumResource错误或没有发现映射驱动器"
      End If  'If success = 0 (WNetEnumResource)
   End If  'If success = 0 (WNetOpenEnum)
  '关闭枚举过程
   Call WNetCloseEnum(hEnum)
End Sub

Private 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
    pos = InStr(item, Chr$(0))
    If pos Then
          TrimNull = Left$(item, pos - 1)
    Else: TrimNull = item
    End If
End Function