高分求助

Question

Private Sub Command1_Click()
' 建立共享 CDISK
CreateShare "F:\", "FDISK", "共享F盘", "", ""
End SubPrivate Sub Command2_Click()
' 取消共享 FDISK
DeleteShare "FDISK"
End Sub
以下在模块中：
Option Explicit
' Net Share Errors
Public Const NERR_NoWorkstation = 2102          ' The workstation driver is not installed.
Public Const NERR_UnknownServer = 2103          ' The server could not be located.
Public Const NERR_RemoteOnly = 2106              ' This operation is not supported on workstations.
Public Const NERR_ServerNotStarted = 2114        ' The Server service is not started.
Public Const NERR_UnknownDevDir = 2116          ' The device or directory does not exist.
Public Const NERR_RedirectedPath = 2117          ' The operation is invalid on a redirected resource.
Public Const NERR_DuplicateShare = 2118          ' The name has already been shared.
Public Const NERR_NetworkError = 2136            ' A general network error occurred.
Public Const NERR_InvalidAPI = 2142              ' The requested API is not supported on the remote server.' Standard Errors
Public Const ERROR_ACCESS_DENIED = 5
Public Const ERROR_INVALID_PARAMETER = 87
Public Const ERROR_INVALID_NAME = 123
Public Const ERROR_INVALID_LEVEL = 124' ******************** Win32 API Declares ********************
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                  (lpDest As Any, lpSource As Any, ByVal lBytes As Long)
' ******************** Net Share Declares ********************
' Share Types
Public Const STYPE_DISKTREE = 0
Public Const STYPE_PRINTQ = 1
Public Const STYPE_DEVICE = 2
Public Const STYPE_IPC = 3
Public Const STYPE_SPECIAL = &H80000000Public Const SHI_USES_UNLIMITED = -1&' Share Access constants
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    '/* The share is recreated when Windows Starts */
Public Const SHI50F_SYSTEM = &H200    '/* The share is not normally visible */
Public Const LM20_NNLEN = 12          '// LM 2.0 Net name length
Public Const LM20_UNLEN = 20          '// LM 2.0 Maximum user name length
Public Const LM20_PWLEN = 14          '// LM 2.0 Maximum password length
Public Const SHPWLEN = 8              '// Share password length (bytes)
Public Const SHARELEVEL50 = 50Public Type SHARE_INFO_50
    yNetName(LM20_NNLEN)    As Byte        'charshi50_netname[LM20_NNLEN+1];
    '/* share name */
    yType                  As Byte        ' unsigned char shi50_type;
    '/* see below */
    nFlags                  As Integer      ' short shi50_flags;
    '/* see below */
    lpzRe              As Long        ' char FAR *shi50_re;
    '/* ANSI comment string */
    lpzPath                As Long        ' char FAR *shi50_path;
    '/* shared resource */
    yRWPassword(SHPWLEN)    As Byte        ' char shi50_rw_password[SHPWLEN+1];
    '/* read-write password (share-level security) */
    yROPassword(SHPWLEN)    As Byte        ' char shi50_ro_password[SHPWLEN+1];
    '/* read-only password (share-level security) */
End TypePublic Declare Function NetShareAdd50 Lib "svrapi" Alias "NetShareAdd" _
                      (ByVal lpzServerName As String, _
                        ByVal nShareLevel As Integer, _
                        ShareInfo As Any, _
                        ByVal nBufferSize As Integer) As LongPublic Declare Function NetShareDelete Lib "svrapi" Alias "NetShareDel" _
                      (ByVal lpzServerName As String, _
                        ByVal sShareName As String, _
                        ByVal nReserved As Integer) As LongPublic Function CreateShare(ByVal sSharePath As String, _
                            ByVal sShareName As String, _
                            ByVal sRe As String, _
                            ByVal sROPass As String, _
                            ByVal sRWPass As String) As Long    ' Create a share that depends on password for RW or RO access.
    ' Returns the errorcode of the create share API call.
    ' Note: this code doesn't check for proper string lengths like it should    Dim ShareInfo      As SHARE_INFO_50
    Dim lReturn        As Long    Dim sServerName    As String
    Dim ySharePath()    As Byte
    Dim yRe()      As Byte    sServerName = ""    ' Create the share on the local computer    With ShareInfo        .yType = STYPE_DISKTREE    ' Disk type share
        .nFlags = SHI50F_PERSIST + SHI50F_DEPENDSON ' + SHI50F_SYSTEM ' if you want the share to be hidden
                                  ' SHI50F_FULL or SHI50F_RDONLY, use one of these instead of SHI50F_DEPENDSON
                                  ' if you only want one kind of access        ' Fill in the path to be shared (Must be in all upper case)
        ySharePath() = StrConv(UCase$(sSharePath & vbNullChar), vbFromUnicode)
        .lpzPath = VarPtr(ySharePath(0))        ' Fill in a comment about the share (Case doesn't matter here)
        yRe() = StrConv(sRe & vbNullChar, vbFromUnicode)
        .lpzRe = VarPtr(yRe(0))        ' Fill in the ShareName to be created (All Upper Case)
        Erase .yNetName()  ' This was just here for debugging in the IDE
        sShareName = UCase$(sShareName & vbNullChar)
        CopyMemory .yNetName(0), ByVal sShareName, Len(sShareName)        ' Fill this in for sharelevel access (Should be all uppercase to avoid NT vs 95/98 troubles)
        Erase .yRWPassword()    ' This was just here for debugging in the IDE
        sRWPass = UCase$(sRWPass & vbNullChar)
        CopyMemory .yRWPassword(0), ByVal sRWPass, Len(sRWPass)        ' Fill this in for sharelevel access (Should be all uppercase to avoid NT vs 95/98 troubles)
        Erase .yROPassword()    ' This was just here for debugging in the IDE
        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
   ' Remove the share from the local computer
   DeleteShare = NetShareDelete("", UCase$(sShareName), 0)
   Debug.Print "lReturn:"; DeleteShare, "DLL Error:"; Err.LastDllError
End Function