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