没试过,但应该可以,因为使用的是系统命令,如果想自己实现的话,请参考以下代码(可以分别创建98/NT下的共享) 看起来还是用Shell更简单'Code by Roy Strickland, submitted by Jarret Peterson 'This code can share and unshare the directory 'c:\dos''=================================== 'start a new project and add three command buttons 'set forms AutoRedraw property to true 'ADD TO A MODULE IN YOUR PROJECT: '==================================== Option Explicit Public Platform As Long 'Platform ID of OS. 1 or 2'Structure for Getversion Public Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 ' Maintenance string for PSS usage End TypePublic Const STYPE_DISKTREE As Long = 0 Public Const STYPE_PRINTQ As Long = 1 Public Const STYPE_DEVICE As Long = 2 Public Const STYPE_IPC As Long = 3'Access types Public Const ACCESS_READ As Long = &H1 Public Const ACCESS_WRITE As Long = &H2 Public Const ACCESS_CREATE As Long = &H4 Public Const ACCESS_EXEC As Long = &H8 Public Const ACCESS_DELETE As Long = &H10 Public Const ACCESS_ATRIB As Long = &H20 Public Const ACCESS_PERM As Long = &H40 Public Const ACCESS_ALL As Long = &H7F Public Const WNTYPE_DRIVE As Long = 1 Public Const SHI_USES_UNLIMITED As Long = -1'Info structures for NetShareAdd Type SHARE_INFO_2 shi2_netname As String * 14 shi2_type As Long shi2_re As String 'Far pointer to string shi2_permissions As Long shi2_max_uses As Long shi2_current_uses As Long shi2_path As String 'Far pointer to string shi2_passwd As String * 10 End TypeType SHARE_INFO_50 shi50_netname As String shi50_type As String shi50_flags As Long shi50_re As String shi50_path As String shi50_rw_password As String shi50_ro_password As String End Type'ACL for Security Descriptor Public Type ACL AclRevision As Byte Sbz1 As Byte AclSize As Integer AceCount As Integer Sbz2 As Integer End Type'Security Descriptor for SHARE_INFO_502 Public Type SECURITY_DESCRIPTOR Revision As Byte Sbz1 As Byte Control As Long Owner As Long Group As Long Sacl As ACL Dacl As ACL End TypeType SHARE_INFO_502 shi502_netname As String shi502_type As Long shi502_re As String shi502_permissions As Long shi502_max_uses As Long shi502_current_uses As Long shi502_path As String shi502_passwd As String shi502_reserved As Long shi502_security_descriptor As SECURITY_DESCRIPTOR End TypePublic Security As SECURITY_DESCRIPTORPublic Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _ (lpVersionInformation As OSVERSIONINFO) As Long Public Declare Function lstrcpy Lib "kernel32" _ (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long 'NT Public Declare Function NetShareDelNT Lib "netapi32.dll" Alias "NetShareDel" _ (ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long Public Declare Function NetShareAddNT Lib "netapi32.dll" Alias "NetShareAdd" _ (ByVal servername As Any, ByVal slevel As Long, _ buf As SHARE_INFO_502, ByVal cbbuf As Long) As Long '9x Public Declare Function NetShareDel9x Lib "svrapi.dll" Alias "NetShareDel" _ (ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long Public Declare Function NetShareAdd9x Lib "svrapi.dll" Alias "NetShareAdd" _ (ByVal servername As Any, ByVal slevel As Long, buf As SHARE_INFO_50, ByVal cbbuf As Long) As Long'==================== 'ADD CODE TO FORM: '==================== Option Explicit Dim SI2 As SHARE_INFO_2 Dim SI502 As SHARE_INFO_502 Dim SI50 As SHARE_INFO_50 Dim OSVERInfo As OSVERSIONINFO Dim ShareRe As String Dim SharePath As String Dim nerr As Long Dim nPath As String Dim pwd As String Dim ret As Long Dim OS As Long Private Sub Form_Load() OSVERInfo.dwOSVersionInfoSize = Len(OSVERInfo) OS = GetVersionEx(OSVERInfo) Command1.Caption = "Create Share NT" Command2.Caption = "Create Share Win9x" Command3.Caption = "Delete Share" End Sub Private Sub Command1_Click() 'NT On Error Resume Next SetStrings nerr = NetShareAddNT(0&, 2, SI502, ret) Print nerr End Sub Private Sub Command2_Click() '9x On Error Resume Next SetStrings nerr = NetShareAdd9x(0&, 50, SI50, ret) Print nerr End Sub Private Sub Command3_Click() 'Delete On Error Resume Next If OSVERInfo.dwPlatformId = 1 Then nerr = NetShareDel9x(0&, nPath, 0&) Else nerr = NetShareDelNT(0&, nPath, 0&) Print nerr End If End Sub Public Sub SetStrings() If OSVERInfo.dwPlatformId = 1 Then '9x OS nPath = "NewShare" ShareRe = "Re for new share" SharePath = "C:\dos" pwd = "Share"
如果要删除共享,请用 Shell "NET SHARE mShare /DELETE",vbhide 删除
看起来还是用Shell更简单'Code by Roy Strickland, submitted by Jarret Peterson
'This code can share and unshare the directory 'c:\dos''===================================
'start a new project and add three command buttons
'set forms AutoRedraw property to true
'ADD TO A MODULE IN YOUR PROJECT:
'====================================
Option Explicit
Public Platform As Long 'Platform ID of OS. 1 or 2'Structure for Getversion
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End TypePublic Const STYPE_DISKTREE As Long = 0
Public Const STYPE_PRINTQ As Long = 1
Public Const STYPE_DEVICE As Long = 2
Public Const STYPE_IPC As Long = 3'Access types
Public Const ACCESS_READ As Long = &H1
Public Const ACCESS_WRITE As Long = &H2
Public Const ACCESS_CREATE As Long = &H4
Public Const ACCESS_EXEC As Long = &H8
Public Const ACCESS_DELETE As Long = &H10
Public Const ACCESS_ATRIB As Long = &H20
Public Const ACCESS_PERM As Long = &H40
Public Const ACCESS_ALL As Long = &H7F
Public Const WNTYPE_DRIVE As Long = 1
Public Const SHI_USES_UNLIMITED As Long = -1'Info structures for NetShareAdd
Type SHARE_INFO_2
shi2_netname As String * 14
shi2_type As Long
shi2_re As String 'Far pointer to string
shi2_permissions As Long
shi2_max_uses As Long
shi2_current_uses As Long
shi2_path As String 'Far pointer to string
shi2_passwd As String * 10
End TypeType SHARE_INFO_50
shi50_netname As String
shi50_type As String
shi50_flags As Long
shi50_re As String
shi50_path As String
shi50_rw_password As String
shi50_ro_password As String
End Type'ACL for Security Descriptor
Public Type ACL
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type'Security Descriptor for SHARE_INFO_502
Public Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
Sacl As ACL
Dacl As ACL
End TypeType SHARE_INFO_502
shi502_netname As String
shi502_type As Long
shi502_re As String
shi502_permissions As Long
shi502_max_uses As Long
shi502_current_uses As Long
shi502_path As String
shi502_passwd As String
shi502_reserved As Long
shi502_security_descriptor As SECURITY_DESCRIPTOR
End TypePublic Security As SECURITY_DESCRIPTORPublic Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function lstrcpy Lib "kernel32" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
'NT
Public Declare Function NetShareDelNT Lib "netapi32.dll" Alias "NetShareDel" _
(ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long
Public Declare Function NetShareAddNT Lib "netapi32.dll" Alias "NetShareAdd" _
(ByVal servername As Any, ByVal slevel As Long, _
buf As SHARE_INFO_502, ByVal cbbuf As Long) As Long
'9x
Public Declare Function NetShareDel9x Lib "svrapi.dll" Alias "NetShareDel" _
(ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long
Public Declare Function NetShareAdd9x Lib "svrapi.dll" Alias "NetShareAdd" _
(ByVal servername As Any, ByVal slevel As Long, buf As SHARE_INFO_50, ByVal cbbuf As Long) As Long'====================
'ADD CODE TO FORM:
'====================
Option Explicit
Dim SI2 As SHARE_INFO_2
Dim SI502 As SHARE_INFO_502
Dim SI50 As SHARE_INFO_50
Dim OSVERInfo As OSVERSIONINFO
Dim ShareRe As String
Dim SharePath As String
Dim nerr As Long
Dim nPath As String
Dim pwd As String
Dim ret As Long
Dim OS As Long
Private Sub Form_Load()
OSVERInfo.dwOSVersionInfoSize = Len(OSVERInfo)
OS = GetVersionEx(OSVERInfo)
Command1.Caption = "Create Share NT"
Command2.Caption = "Create Share Win9x"
Command3.Caption = "Delete Share"
End Sub
Private Sub Command1_Click()
'NT
On Error Resume Next
SetStrings
nerr = NetShareAddNT(0&, 2, SI502, ret)
Print nerr
End Sub
Private Sub Command2_Click()
'9x
On Error Resume Next
SetStrings
nerr = NetShareAdd9x(0&, 50, SI50, ret)
Print nerr
End Sub
Private Sub Command3_Click()
'Delete
On Error Resume Next
If OSVERInfo.dwPlatformId = 1 Then
nerr = NetShareDel9x(0&, nPath, 0&)
Else
nerr = NetShareDelNT(0&, nPath, 0&)
Print nerr
End If
End Sub
Public Sub SetStrings()
If OSVERInfo.dwPlatformId = 1 Then
'9x OS
nPath = "NewShare"
ShareRe = "Re for new share"
SharePath = "C:\dos"
pwd = "Share"
SI50.shi50_netname = nPath
SI50.shi50_path = SharePath SI50.shi50_re = ShareRe
SI50.shi50_type = STYPE_DISKTREE
SI50.shi50_ro_password = vbNullChar
SI50.shi50_rw_password = vbNullChar
Else
'NT OS
nPath = StrConv("NewShare", vbUnicode)
ShareRe = StrConv("Re for new share", vbUnicode)
SharePath = StrConv("C:\dos", vbUnicode)
pwd = StrConv("Share", vbUnicode)
SI502.shi502_current_uses = 0
SI502.shi502_max_uses = 10
SI502.shi502_netname = nPath
SI502.shi502_passwd = pwd
SI502.shi502_path = SharePath
SI502.shi502_permissions = ACCESS_ALL
SI502.shi502_re = ShareRe
SI502.shi502_reserved = 0
SI502.shi502_security_descriptor = Security
SI502.shi502_type = STYPE_DISKTREE
End If
End Sub
?????????