?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -