form1.frm

映射网络驱动器 映射网络驱动器

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "映射网络驱动器"
   ClientHeight    =   4335
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4740
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4335
   ScaleWidth      =   4740
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame3 
      Caption         =   "系统公告"
      Height          =   2055
      Left            =   0
      TabIndex        =   15
      Top             =   2280
      Width           =   4740
      Begin VB.DriveListBox Drive1 
         Height          =   300
         Left            =   600
         TabIndex        =   18
         Top             =   480
         Width           =   975
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   240
         TabIndex        =   17
         Top             =   1750
         Width           =   4455
      End
      Begin VB.Label Label3 
         Height          =   1455
         Left            =   120
         TabIndex        =   16
         Top             =   240
         Width           =   4455
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "映射网络驱动器"
      Height          =   1500
      Left            =   0
      TabIndex        =   6
      Top             =   0
      Width           =   4740
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   975
         TabIndex        =   14
         Text            =   "Combo1"
         Top             =   520
         Width           =   2535
      End
      Begin VB.CommandButton Command3 
         Caption         =   "关闭"
         Height          =   330
         Left            =   3645
         TabIndex        =   12
         TabStop         =   0   'False
         Top             =   945
         Width           =   950
      End
      Begin VB.CommandButton Command1 
         Caption         =   "连接"
         Height          =   330
         Left            =   3645
         TabIndex        =   7
         TabStop         =   0   'False
         Top             =   390
         Width           =   950
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Index           =   0
         Left            =   975
         Locked          =   -1  'True
         TabIndex        =   1
         Text            =   "Z:"
         Top             =   225
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Index           =   2
         Left            =   975
         TabIndex        =   2
         Top             =   840
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Index           =   3
         Left            =   975
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   1150
         Width           =   2535
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "驱动器:"
         Height          =   180
         Index           =   0
         Left            =   165
         TabIndex        =   11
         Top             =   255
         Width           =   630
      End
      Begin VB.Label Label1 
         Caption         =   "用户级别:"
         Height          =   240
         Index           =   1
         Left            =   150
         TabIndex        =   10
         Top             =   585
         Width           =   870
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "用户名:"
         Height          =   180
         Index           =   2
         Left            =   165
         TabIndex        =   9
         Top             =   885
         Width           =   630
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "口  令:"
         Height          =   180
         Index           =   3
         Left            =   165
         TabIndex        =   8
         Top             =   1200
         Width           =   630
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "断开网络驱动器"
      Height          =   705
      Left            =   0
      TabIndex        =   5
      Top             =   1545
      Width           =   4740
      Begin VB.CommandButton Command2 
         Caption         =   "断开"
         Height          =   330
         Left            =   3630
         TabIndex        =   13
         TabStop         =   0   'False
         Top             =   225
         Width           =   950
      End
      Begin VB.TextBox Text2 
         Height          =   285
         Left            =   975
         Locked          =   -1  'True
         TabIndex        =   4
         Text            =   "Z:"
         Top             =   255
         Width           =   2505
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "驱动器:"
         Height          =   180
         Index           =   4
         Left            =   150
         TabIndex        =   0
         Top             =   300
         Width           =   630
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'WNetAddConnection2创建同一个网络资源的连接

'返回值
'Long，零表示成功。会设置GetLastError。如GetLastError是ERROR_EXTENDED_ERROR，则可用WNetGetLastError取得额外的错误信息

'参数 类型及说明

'lpNetResource NETRESOURCE，在这个结构中设置了下述字段，对要连接的网络资源进行了定义：dwType， lpLocalName （可为 vbNullString），
'                           lpRemoteName， lpProvider （设为 vbNullString 表示用默认提供者）。该结构的其他所有变量都会被忽略
'lpPassword String，可选的一个密码。如为vbNullString，表示采用当前用户的默认密码。如为一个空字串，则不用任何密码
'lpUserName String，用于连接的用户名。如为vbNullString，表示使用当前用户
'dwFlags Long，设为零；或指定常数CONNECT_UPDATE_PROFILE，表示创建永久性连接

Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _
                          (lpNetResource As NETRESOURCE, _
                          ByVal lpPassword As String, _
                          ByVal lpUserName As String, _
                          ByVal dwFlags As Long) _
                          As Long

'WNetCancelConnection2结束一个网络连接

'返回值
'Long，零表示成功。会设置GetLastError。如GetLastError是ERROR_EXTENDED_ERROR，则可用WNetGetLastError取得额外的错误信息

'参数 类型及说明

'lpszName String，已连接资源的远程名称或本地名称
'dwFlags Long，设为零或CONNECT_UPDATE_PROFILE。如为零，而且建立的是永久性连接，则在windows下次重新启动时仍会重新连接
'fForce Long，如为TRUE，表示强制断开连接（即使连接的资源上正有打开的文件或作业）

Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _
                          (ByVal lpName As String, _
                          ByVal dwFlags As Long, _
                          ByVal fForce As Long) _
                          As Long

'与网络有关的重要任务之一就是枚举，或者说获取可用网络资源的一个列表。这个结构用以定义系统的的每个网络资源
'字段表
'字段 类型及说明

'dwScope Long，下述常数之一：

'RESOURCE_CONNECTED 枚举连接的资源
'RESOURCE_GLOBALNET 枚举所有资源
'RESOURCE_REMEMBERED 枚举永久性连接

'dwType Long，下述常数之一：
'RESOURCETYPE_ANY 枚举所有资源
'RESOURCETYPE_DISK 枚举磁盘
'RESOURCETYPE_PRINT 枚举打印机

'dwDisplayType Long，带有前缀RESOURCEDISPLAYTYPE的一个常数，对资源的类型进行了定义（在网络浏览器中如何显示）
'dwUsage Long，下述标志的一个或多个
'RESOURCEUSAGE_CONNECTABLE 可同这个资源连接
'RESOURCEUSAGE_CONTAINER 这个资源包含了可以枚举的额外资源

Private Type NETRESOURCE

    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String     '由本地系统引用的资源名称。只能用于已连接的资源
    lpRemoteName As String    '资源的网络名
    lpComment As String       '由网络供应商设置
    lpProvider As String      '网络供应商的名字

End Type

Private Const NO_ERROR = 0                     '是否有错误
Private Const CONNECT_UPDATE_PROFILE = &H1     '表示创建永久性连接
Private Const RESOURCETYPE_DISK = &H1          '枚举磁盘
Private Const RESOURCETYPE_PRINT = &H2         '枚举打印机
Private Const RESOURCETYPE_ANY = &H0           '枚举所有资源
Private Const RESOURCE_CONNECTED = &H1         '枚举连接的资源
Private Const RESOURCE_REMEMBERED = &H3        '枚举永久性连接
Private Const RESOURCE_GLOBALNET = &H2         '枚举所有资源
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3
Private Const RESOURCEUSAGE_CONNECTABLE = &H1  '可同这个资源连接

Private Sub Command1_Click()   '连接

    Dim NR As NETRESOURCE
    Dim MyErr As Long

    NR.dwScope = RESOURCE_GLOBALNET                      '枚举所有资源
    NR.dwType = RESOURCETYPE_DISK                        '枚举磁盘
    NR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE         '在网络浏览器中如何显示
    NR.dwUsage = RESOURCEUSAGE_CONNECTABLE               '可同这个资源连接
    NR.lpLocalName = Text1(0).Text                       '由本地系统引用的资源名称。只能用于已连接的资源
    NR.lpRemoteName = "\\" & Basic("ip") & "\本地磁盘 (F)"  '资源的网络名
    Select Case Me.Combo1.ListIndex
    Case "0"
    If Text1(2).Text = Basic("name") Then
        If Text1(3).Text = Basic("pas") Then
            MyErr = WNetAddConnection2(NR, Text1(3).Text, Text1(2).Text, CONNECT_UPDATE_PROFILE)
            If MyErr = NO_ERROR Then
                MsgBox "网络驱动器映射成功!", vbInformation, "映射信息提示"
            Else
                MsgBox "出现错误：" & Err.Description & " - 网络驱动器映射失败!", vbExclamation, "映射信息提示"
            End If
        Else
            MsgBox "密码错误!", vbInformation, "登陆提示"
        End If
    Else
        MsgBox "用户名错误!", vbInformation, "登陆提示"
    End If
    End Select
    End Sub

Private Sub Command2_Click()  '断开

    Dim MyErr As Long
    Dim strName As String

    strName = Text2.Text
    MyErr = WNetCancelConnection2(strName, CONNECT_UPDATE_PROFILE, False)

    If MyErr = NO_ERROR Then

        MsgBox "成功断开驱动器映射!", vbInformation, "断开信息提示"

    Else

        MsgBox "出现错误： " & Err.Description & " - 驱动器断开失败!", vbExclamation, "断开信息提示"

    End If

End Sub

Private Sub Command3_Click()

    Unload Me

End Sub

Private Sub Form_Load()
    Me.Combo1.AddItem "后期编辑员", 0
    Me.Combo1.ListIndex = 0             '使默认项为0
    news
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        Text1(Index + 1).SetFocus
        If Index = 3 Then
            Command1.SetFocus
        End If
        If Index = 4 Then
            Command2.SetFocus
        End If
    End If
End Sub
Sub news()
ConnOpen
Rs.Open "Select top 1 * From [news] order by times desc", Conn, 1, 3
If Rs.EOF And Rs.BOF Then
    MsgBox "数据库连接失败，请稍候再来...", vbInformation
Else
    Label3.Caption = n_h(Rs("news"))
    Label4.Caption = "消息发布时间：[" & Rs("times") & "]"
End If
Rs.Close
ConnClose
End Sub

Public Function n_h(ByVal strText As String) As String
strText = Replace(strText, "[next]", vbCrLf)
n_h = strText
End Function