frmmain.frm

VB映射网络磁盘,可用于网吧将共享目录映射到客户机！

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "映射网络驱动器"
   ClientHeight    =   4665
   ClientLeft      =   3195
   ClientTop       =   2400
   ClientWidth     =   6375
   LinkTopic       =   "Form1"
   ScaleHeight     =   4665
   ScaleWidth      =   6375
   Begin VB.Frame Frame2 
      Caption         =   "断开网络驱动器"
      Height          =   3735
      Left            =   3240
      TabIndex        =   2
      Top             =   120
      Width           =   3015
      Begin VB.TextBox Text1 
         Height          =   285
         Index           =   4
         Left            =   120
         TabIndex        =   12
         Text            =   "Z:"
         Top             =   600
         Width           =   2175
      End
      Begin VB.CommandButton cmdDisconnect 
         Caption         =   "断开(&D)"
         Height          =   495
         Left            =   1560
         TabIndex        =   3
         Top             =   3000
         Width           =   1215
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "驱动器:"
         Height          =   180
         Index           =   4
         Left            =   120
         TabIndex        =   13
         Top             =   360
         Width           =   630
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "映射网络驱动器"
      Height          =   3735
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3015
      Begin VB.TextBox Text1 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Index           =   3
         Left            =   240
         PasswordChar    =   "*"
         TabIndex        =   10
         Text            =   "123"
         Top             =   2400
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Index           =   2
         Left            =   240
         TabIndex        =   8
         Text            =   "user"
         Top             =   1800
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Index           =   1
         Left            =   240
         TabIndex        =   6
         Text            =   "\\192.168.0.254\tool$"
         Top             =   1200
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Index           =   0
         Left            =   240
         TabIndex        =   4
         Text            =   "Z:"
         Top             =   600
         Width           =   2535
      End
      Begin VB.CommandButton cmdConnect 
         Caption         =   "连接(&C)"
         Height          =   495
         Left            =   1560
         TabIndex        =   1
         Top             =   3000
         Width           =   1215
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "口令:"
         Height          =   180
         Index           =   3
         Left            =   240
         TabIndex        =   11
         Top             =   2160
         Width           =   450
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "用户名:"
         Height          =   180
         Index           =   2
         Left            =   240
         TabIndex        =   9
         Top             =   1560
         Width           =   630
      End
      Begin VB.Label Label1 
         Caption         =   "远程路径:"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   7
         Top             =   960
         Width           =   2175
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "驱动器:"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   5
         Top             =   360
         Width           =   630
      End
   End
   Begin VB.Label lblMyWeb 
      AutoSize        =   -1  'True
      Caption         =   "主页：http://www.daands.cn"
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   480
      TabIndex        =   15
      Top             =   4200
      Width           =   2340
   End
   Begin VB.Label lblMyMail 
      AutoSize        =   -1  'True
      Caption         =   "电子信箱：[e-mail]"
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   3720
      TabIndex        =   14
      Top             =   4200
      Width           =   2340
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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

Const NO_ERROR = 0
Const CONNECT_UPDATE_PROFILE = &H1
Const RESOURCETYPE_DISK = &H1
Const RESOURCETYPE_PRINT = &H2
Const RESOURCETYPE_ANY = &H0
Const RESOURCE_CONNECTED = &H1
Const RESOURCE_REMEMBERED = &H3
Const RESOURCE_GLOBALNET = &H2
Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Const RESOURCEDISPLAYTYPE_SERVER = &H2
Const RESOURCEDISPLAYTYPE_SHARE = &H3
Const RESOURCEUSAGE_CONNECTABLE = &H1
Const RESOURCEUSAGE_CONTAINER = &H2

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

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

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub cmdConnect_Click()

    Dim NetR As NETRESOURCE
    Dim ErrInfo As Long
    
    NetR.dwScope = RESOURCE_GLOBALNET
    NetR.dwType = RESOURCETYPE_DISK
    NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
    NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
    NetR.lpLocalName = Text1(0).Text
    NetR.lpRemoteName = Text1(1).Text
    
    ErrInfo = WNetAddConnection2(NetR, Text1(3).Text, Text1(2).Text, CONNECT_UPDATE_PROFILE)
    
    If ErrInfo = NO_ERROR Then
        MsgBox "网络驱动器映射成功!", vbInformation, "映射"
    Else
        MsgBox "ERROR: " & Str(ErrInfo) & " - 网络驱动器映射失败!", _
        vbExclamation, "映射"
    End If

End Sub

Private Sub cmdDisconnect_Click()

    Dim ErrInfo As Long
    Dim strLocalName As String
    
    strLocalName = Text1(4).Text
    ErrInfo = WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE, False)
    
    If ErrInfo = NO_ERROR Then
        MsgBox "成功断开驱动器映射!", vbInformation, "断开"
    Else
        MsgBox "ERROR: " & Str(ErrInfo) & " - 驱动器断开失败!", _
        vbExclamation, "断开"
    End If

End Sub

Private Sub lblMyMail_Click()
    ShellExecute hwnd, "open", "mailto:[e-mail]", vbNullString, vbNullString, 0
End Sub

Private Sub lblMyWeb_Click()
    ShellExecute 0, "open", "http://www.daands.cn", vbNullString, vbNullString, 3
End Sub