共享驱动器

[vickia]

如何共享WIN98下的驱动器,如:D:盘

[3661512]

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

在一个独立模块中输入：


'Subject: Re: NetAccess Add
'Date: Wed, 27 Jan 1999 09:00:16 -0700
'From: "Eric Hoffman" <[e-mail]>
'Organization: Posted via RemarQ, http://www.remarQ.com - Discussions start here!
'Newsgroups: microsoft.Public.VB.winapi.networks

'*****Here is the code to SHARE FOLDERS under 95/98.******

'Note: This is only an example of how to create a Share-Level-Access share.
'For User-Level-Access it will be a little different. I have finally figured
'it out, but I haven't put together a clean routine to do it yet. When I do,
'I'll post It also.

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 = &H80000000

Public 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 = 50

Public 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 */
lpzRemark As Long ' char FAR *shi50_remark;
'/* 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 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

' 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 yRemark() 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)
yRemark() = StrConv(sRemark & vbNullChar, vbFromUnicode)
.lpzRemark = VarPtr(yRemark(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