98/ME下实现文件夹的共享和删除共享

'独立模块中输入
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