Private Const NERR_SUCCESS As Long = 0&
Private Const STYPE_ALL As Long = -1 'note: my const
Private Const STYPE_DISKTREE As Long = 0
Private Const STYPE_PRINTQ As Long = 1
Private Const STYPE_DEVICE As Long = 2
Private Const STYPE_IPC As Long = 3
Private Const STYPE_SPECIAL As Long = &H80000000
'permissions
Private Const ACCESS_READ As Long = &H1
Private Const ACCESS_WRITE As Long = &H2
Private Const ACCESS_CREATE As Long = &H4
Private Const ACCESS_EXEC As Long = &H8
Private Const ACCESS_DELETE As Long = &H10
Private Const ACCESS_ATRIB As Long = &H20
Private Const ACCESS_PERM As Long = &H40
Private Const ACCESS_ALL As Long = ACCESS_READ Or _
ACCESS_WRITE Or _
ACCESS_CREATE Or _
ACCESS_EXEC Or _
ACCESS_DELETE Or _
ACCESS_ATRIB Or _
ACCESS_PERM
Private Type SHARE_INFO_2
shi2_netname As Long
shi2_type As Long
shi2_remark As Long
shi2_permissions As Long
shi2_max_uses As Long
shi2_current_uses As Long
shi2_path As Long
shi2_passwd As Long
End Type
Private Declare Function NetShareAdd Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
buf As Any, _
parmerr As Long) As Long
Private Declare Function NetShareDelete Lib "netapi32()" (ByVal servername As Long, _
ByVal level As Long, _
buf As Any, _
parmerr As Long) As Long
Private Function ShareAdd(sServer As String, _
sSharePath As String, _
sShareName As String, _
sShareRemark As String, _
sSharePw As String) As Long
Dim dwServer As Long
Dim dwNetname As Long
Dim dwPath As Long
Dim dwRemark As Long
Dim dwPw As Long
Dim parmerr As Long
Dim si2 As SHARE_INFO_2
dwServer = StrPtr(sServer)
dwNetname = StrPtr(sShareName)
dwPath = StrPtr(sSharePath)
If Len(sShareRemark) > 0 Then
dwRemark = StrPtr(sShareRemark)
End If
If Len(sSharePw) > 0 Then
dwPw = StrPtr(sSharePw)
End If
With si2
.shi2_netname = dwNetname
.shi2_path = dwPath
.shi2_remark = dwRemark
.shi2_type = STYPE_DISKTREE
.shi2_permissions = &H1 'ACCESS_READ
.shi2_max_uses = -1
.shi2_passwd = dwPw
End With
ShareAdd = NetShareAdd(dwServer, 2, si2, parmerr)
End Function
Private Sub Command1_Click()
Dim fpath As String
Dim sharename As String
fpath = "e:\"
sharename = "1234"
Public Function CreateShare _ ' 建立資源分享模組
(ByVal sSharePath As String, _ ' 完整路徑
ByVal sShareName As String, _ ' 資源分享名稱
ByVal sRemark As String, _ ' 說明
ByVal sROPass As String, _ ' 唯讀密碼
ByVal sRWPass As String) As Long ' 完整存取密碼
Public Function DeleteShare _ ' 取消資源分享模組
(ByVal sShareName As String) As Long ' 資源分享名稱
呼叫範例如下:
Private Sub Command1_Click()
' 建立資源分享 CDISK
CreateShare "C:\ ", "CDISK ", "小紀的 C 磁碟機 ", "JWHR ", "JWHRW "
End Sub
Private Sub Command2_Click()
' 取消資源分享 CDISK
DeleteShare "CDISK "
End Sub
註:就像一般教人家做壞事的書或電視節目一樣,我也要聲明一下:
註:以上方式請用於正途 (系統需要),請勿使用以上方法來不當竊取不該看的檔案!