'独立模块中输入
Option Explicit
' 共享错误信息
Public Const NERR_NoWorkstation = 2102 ' 工作站驱动器未被安装.
Public Const NERR_UnknownServer = 2103 ' 机器名不可用.
Public Const NERR_RemoteOnly = 2106 ' 该操作不被机器支持.
Public Const NERR_ServerNotStarted = 2114 ' 服务未启动.
Public Const NERR_UnknownDevDir = 2116 ' 目录或驱动器不存在.
Public Const NERR_RedirectedPath = 2117 ' 该共享资源不能被共享.
Public Const NERR_DuplicateShare = 2118 ' 该共享名已被使用.
Public Const NERR_NetworkError = 2136 ' 发生一般网络错误,共享失败.
Public Const NERR_InvalidAPI = 2142 ' 该API不被远端机器所支持.
' 标准错误信息
Public Const ERROR_ACCESS_DENIED = 5
Public Const ERROR_INVALID_PARAMETER = 87
Public Const ERROR_INVALID_NAME = 123
Public Const ERROR_INVALID_LEVEL = 124
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal lBytes As Long)
' 共享类型
Public Const STYPE_DISKTREE = 0
Public Const STYPE_PRINTQ = 1
Public Const STYPE_DEVICE = 2
Public Const STYPE_IPC = 3
Public Const STYPE_SPECIAL = &H80000000
Public Const SHI_USES_UNLIMITED = -1&
' 共享权限
Public Const SHI50F_RDONLY = &H1
Public Const SHI50F_FULL = &H2
Public Const SHI50F_DEPENDSON = SHI50F_RDONLY Or SHI50F_FULL
Public Const SHI50F_ACCESSMASK = SHI50F_RDONLY Or SHI50F_FULL
Public Const SHI50F_PERSIST = &H100
Public Const SHI50F_SYSTEM = &H200 '/* 该共享是不可见的 */
Public Const LM20_NNLEN = 12 '// LM 2.0 机器名长度
Public Const LM20_UNLEN = 20 '// LM 2.0 用户名称最大长度
Public Const LM20_PWLEN = 14 '// LM 2.0 密码最大长度
Public Const SHPWLEN = 8 '// 共享密码 (bytes)
Public Const SHARELEVEL50 = 50
Public Type SHARE_INFO_50
yNetName(LM20_NNLEN) As Byte 'charshi50_netname[LM20_NNLEN+1];
'/* 共享名称 */
yType As Byte ' unsigned char shi50_type;
nFlags As Integer ' short shi50_flags;
lpzRemark As Long ' char FAR *shi50_remark;
lpzPath As Long ' char FAR *shi50_path;
'/* 共享路径 */
yRWPassword(SHPWLEN) As Byte ' char shi50_rw_password[SHPWLEN+1];
'/* 可读/写共享密码 */
yROPassword(SHPWLEN) As Byte ' char shi50_ro_password[SHPWLEN+1];
'/* 只读共享密码 */
End Type
Public Declare Function NetShareAdd50 Lib "svrapi" Alias "NetShareAdd" _
(ByVal lpzServerName As String, _
ByVal nShareLevel As Integer, _
ShareInfo As Any, _
ByVal nBufferSize As Integer) As Long
Public Declare Function NetShareDelete Lib "svrapi" Alias "NetShareDel" _
(ByVal lpzServerName As String, _
ByVal sShareName As String, _
ByVal nReserved As Integer) As Long
'*************建立共享********************
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
Dim ShareInfo As SHARE_INFO_50
Dim lReturn As Long
Dim sServerName As String
Dim ySharePath() As Byte
Dim yRemark() As Byte
sServerName = "" '建立一个本地共享
With ShareInfo
.yType = STYPE_DISKTREE ' Disk type share
.nFlags = SHI50F_PERSIST + SHI50F_DEPENDSON ' + SHI50F_SYSTEM '
ySharePath() = StrConv(UCase$(sSharePath & vbNullChar), vbFromUnicode)
.lpzPath = VarPtr(ySharePath(0))
yRemark() = StrConv(sRemark & vbNullChar, vbFromUnicode)
.lpzRemark = VarPtr(yRemark(0))
Erase .yNetName()
sShareName = UCase$(sShareName & vbNullChar)
CopyMemory .yNetName(0), ByVal sShareName, Len(sShareName)
Erase .yRWPassword()
sRWPass = UCase$(sRWPass & vbNullChar)
CopyMemory .yRWPassword(0), ByVal sRWPass, Len(sRWPass)
Erase .yROPassword()
sROPass = UCase$(sROPass & vbNullChar)
CopyMemory .yROPassword(0), ByVal sROPass, Len(sROPass)
End With
lReturn = NetShareAdd50(sServerName, SHARELEVEL50, ShareInfo, LenB(ShareInfo))
Debug.Print "lReturn:"; lReturn
CreateShare = lReturn
End Function
'******************删除共享**************************
Public Function DeleteShare(ByVal sShareName As String) As Long
DeleteShare = NetShareDelete("", UCase$(sShareName), 0)
Debug.Print "lReturn:"; DeleteShare, "DLL Error:"; Err.LastDllError
End Function
