form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H80000001&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "网络资源"
   ClientHeight    =   5040
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3240
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5040
   ScaleWidth      =   3240
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command1 
      Caption         =   "结束"
      Height          =   375
      Index           =   7
      Left            =   240
      TabIndex        =   7
      Top             =   4320
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "显示资源管理器"
      Height          =   375
      Index           =   6
      Left            =   240
      TabIndex        =   6
      Top             =   3600
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "连接下一个自由网络驱动器"
      Height          =   375
      Index           =   5
      Left            =   240
      TabIndex        =   5
      Top             =   2880
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "连接网络驱动器"
      Height          =   375
      Index           =   4
      Left            =   240
      TabIndex        =   4
      Top             =   2520
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "断开网络打印机"
      Height          =   375
      Index           =   3
      Left            =   240
      TabIndex        =   3
      Top             =   1680
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "添加打印机"
      Height          =   375
      Index           =   2
      Left            =   240
      TabIndex        =   2
      Top             =   1320
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "断开网络驱动器"
      Height          =   375
      Index           =   1
      Left            =   240
      TabIndex        =   1
      Top             =   480
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "映射网络驱动器"
      Height          =   375
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   2535
   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(Index As Integer)
    Dim x As Long
   Select Case Index
      Case 0: '映射网络驱动器
              '如果函数成功，则返回ERROR_SUCCESS (0)，如果用户选择了对话框中的
              '“取消”按钮，则返回&HFFFFFFFF。
              '
              '传递对话框的父窗口的句柄，如果传递0&，则表示以桌面窗口作为父窗口。
               Call WNetConnectionDialog(Me.hwnd, RESOURCETYPE_DISK)
      
      Case 1: '断开网络驱动器
              '如果函数成功，则返回ERROR_SUCCESS (0)，如果用户选择了对话框中的
              '“取消”按钮，则返回&HFFFFFFFF。
              '
              '传递对话框的父窗口的句柄，如果传递0&，则表示以桌面窗口作为父窗口。
               Call WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_DISK)
               
      Case 2: '映射网络打印机。
              '需确认下一个代码的Shell块。如果将它们简化到一行中，则必须是这样的格式：
              '"rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter"。

               Call Shell("rundll32.exe shell32.dll," & _
                          "SHHelpShortcuts_RunDLL AddPrinter", _
                           vbNormalFocus)
              '在Windows NT中，可能会显示一个先前定义的Windows对话框，以连接到一个网络打印机。
              '即类似于使用函数ConnectToPrinterDlg。但是，Windows 95 下的VB程序却不能访问该对话框，
              '因此，必须使用一个命令来启动“添加打印机向导”。
               
      Case 3: '断开网络打印机
              '如果函数成功，则返回ERROR_SUCCESS (0)，如果用户选择了对话框中的
              '“取消”按钮，则返回&HFFFFFFFF。
              
              '传递对话框的父窗口的句柄，如果传递0&，则表示以桌面窗口作为父窗口。
               Call WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_PRINT)
      Case 4: '连接到由驱动器字符指定的服务器上
               MsgBox ConnectThisNetworkDrive("\\someserver\c$", "G:")
      Case 5: '连接到下一个驱动器
               MsgBox ConnectNextFreeNetworkDrive("\\someserver\c$")
      Case 6: '显示资源管理器
               Call ShellExecute(0&, "Open", _
                                 "explorer.exe", "/e,/n,c:\", _
                                 0&, SW_SHOWNORMAL)
      Case 7: '退出
               Unload Me
   End Select

End Sub

Public Function ConnectNextFreeNetworkDrive(serverpath As String) As String
   Dim NETR As NETRESOURCE
   Dim errInfo As Long
   Dim x As Long
   Dim testDrv As String
   
  '设置第一个驱动器为C(ASCII码为67)，然后每次让该ASCII值增加1，
  '直至找到最后一个驱动器。
   x = 67
   Do
     '逐一测试磁盘驱动器
      x = x + 1
      testDrv = Chr$(x) & ":"
      With NETR
         .dwScope = RESOURCE_GLOBALNET
         .dwType = RESOURCETYPE_DISK
         .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
         .dwUsage = RESOURCEUSAGE_CONNECTABLE
         .lpRemoteName = serverpath
         .lpLocalName = testDrv
      End With
      errInfo = WNetAddConnection2(NETR, _
                                   vbNullString, _
                                   "username", _
                                   CONNECT_UPDATE_PROFILE)
   Loop Until x = 90 Or errInfo = ERROR_SUCCESS   'ASCII为90表示的是字符'z'
  '如果成功，返回驱动器
   If errInfo = ERROR_SUCCESS Then
         ConnectNextFreeNetworkDrive = testDrv
   Else: ConnectNextFreeNetworkDrive = "无设备"
   End If
End Function

Public Function ConnectThisNetworkDrive(serverpath As String, _
                                        driveletter As String) As Boolean
  '尝试连接到指定的驱动器上，如果成功，则返回ErrInfo=ERROR_SUCCESS。
   Dim NETR As NETRESOURCE
   Dim errInfo As Long
   With NETR
      .dwScope = RESOURCE_GLOBALNET
      .dwType = RESOURCETYPE_DISK
      .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
      .dwUsage = RESOURCEUSAGE_CONNECTABLE
      .lpRemoteName = serverpath
      .lpLocalName = driveletter
   End With
   errInfo = WNetAddConnection2(NETR, _
                                vbNullString, _
                                "username", CONNECT_UPDATE_PROFILE)
                                
   ConnectThisNetworkDrive = errInfo = ERROR_SUCCESS
End Function