VB建立共享文件夹

Following code is just for winnt/2000:
Public Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Const HEAP_ZERO_MEMORY = &H8
Public Const LM20_NNLEN = 12
Public Type wshare_info_1 'USE FOR WIN98
shi1_netname(13) As Byte
shi1_pad1 As Byte
shi1_type As Integer
shi1_remark As Byte
End Type
Public Type Share_Info_1 'Use for WINNT/2000
shi1_netname As Long
shi1_type As Long
shi1_remark As Long
End Type
Public Type SHARE_INFO_2
shi2_netname As Long
shi2_type As Long
shi2_remark As Long
shi2_permissions As Long
shi2_max_uses As Long
shi2_current_uses As Long
shi2_path As Long
shi2_passwd As Long
End Type
Public Type MungeLong
x As Long
dummy As Integer
End Type
Public Type MungeInt
XLo As Integer
XHi As Integer
dummy As Integer
End Type
Public Const WM_SETTEXT = &HC
Public Const ERROR_SUCCESS = 0
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_NO_SUCH_ALIAS = 1376&
Public Const STYPE_DISKTREE = 0
Public Const STYPE_PRINTQ = 1
Public Const STYPE_DEVICE = 2
Public Const STYPE_IPC = 3

Option Explicit
'Add a Net Share resource
Private Sub CmdAddShare_Click()
Dim strPath As String, strShare As String, nPtrShare As Long
Dim SParray() As Byte, sSarray() As Byte, retVal As Long
Dim nPtrNetName As Long, nPtrPath As Long, nHandleHeap As Long
nHandleHeap = GetProcessHeap()
If nHandleHeap = 0 Then Exit Sub
strPath = Me.Dir1.Path
strShare = StrConv(Right(strPath, Len(strPath) - InStrRev(strPath, "/")),vbUnicode)
strPath = StrConv(Me.Dir1.Path, vbUnicode)
nPtrNetName = HeapAlloc(nHandleHeap, HEAP_ZERO_MEMORY, LenB(strShare) + 1)
nPtrPath = HeapAlloc(nHandleHeap, HEAP_ZERO_MEMORY, LenB(strPath) + 1)
If IsNull(nPtrNetName) Or IsNull(nPtrPath) Then Exit Sub
lstrcpyW ByVal nPtrPath, ByVal strPath
lstrcpyW ByVal nPtrNetName, ByVal strShare
Dim i As Integer
Dim buf(1 To 32) As Byte
For i = 1 To 32
buf(i) = 0
Next
Dim x As Long
Dim tdfShare_Info As SHARE_INFO_2
tdfShare_Info.shi2_netname = nPtrNetName
tdfShare_Info.shi2_type = 0
tdfShare_Info.shi2_remark = 0
tdfShare_Info.shi2_permissions = &HFF
tdfShare_Info.shi2_max_uses = -1
tdfShare_Info.shi2_current_uses = 0
tdfShare_Info.shi2_path = nPtrPath
tdfShare_Info.shi2_remark = 0
retVal = NetShareAdd(ByVal 0, 2, tdfShare_Info, ByVal 0)
HeapFree nHandleHeap, 0, ByVal nPtrPath
HeapFree nHandleHeap, 0, ByVal nPtrNetName
CloseHandle nHandleHeap
CmdEnum_Click
End Sub
'Delete Net Share Resource
Private Sub CMDDeleteShare_Click()
Dim strShareRes As String, retVal As Long
strShareRes = StrConv(Trim(List1.Text), vbUnicode)
retVal = NetShareDel(ByVal 0, strShareRes, 0)
CmdEnum_Click
End Sub
'Enum Net share resource
Private Sub CmdEnum_Click()
Me.List1.Clear
Dim strNetShareName As String, strNetShareRemark As String, nShareType As Long
Dim nLevel As Long
Dim result As Long, bufptr As Long, entriesread As Long, totalentries As Long, resumehandle As Long, BufLen As Long, _
DNArray() As Byte, SNArray(99) As Byte, UNArray() As Byte, _
SName As String, i As Integer, UNPtr As Long, _
TempPtr As MungeLong, TempStr As MungeInt
BufLen = -1 ' Buffer size
resumehandle = 0 ' Start with the first entry
nLevel = 1
Do

result = NetShareEnum(ByVal 0, nLevel, bufptr, BufLen, entriesread, totalentries, resumehandle)

If result <> ERROR_SUCCESS And result <> ERROR_MORE_DATA Then
MsgBox ("Error " & result & " enumerating share " & entriesread & " of " & totalentries)
Exit Sub
End If
Dim j As Long
For i = 1 To entriesread
' Get pointer to string from beginning of buffer
' Copy 4 byte block of memory each time
j = (i - 1) * 3

result = PtrToInt(TempPtr.x, bufptr + j * 4, 4)
result = PtrToStr(SNArray(0), TempPtr.x)
strNetShareName = Left(SNArray, StrLen(TempPtr.x))

result = PtrToInt(TempPtr.x, bufptr + (j + 1) * 4, 4)
nShareType = TempPtr.x

result = PtrToInt(TempPtr.x, bufptr + (j + 2) * 4, 4)
result = PtrToStr(SNArray(0), TempPtr.x)
strNetShareRemark = Left(SNArray, StrLen(TempPtr.x))

List1.AddItem strNetShareName

Next i

result = NetApiBufferFree(bufptr)
Loop Until entriesread = totalentries
End Sub
使用shell命令：(测试环境：NT4.0/Win2000)
Option Explicit
Private Sub Command1_Click() 设置共享

Dim RetVal As Long
RetVal = Shell("net share AAA=D:/SQLXML", 0)
If RetVal = 0 Then
MsgBox ("Error")
Else
MsgBox ("OK")
End If

End Sub
Private Sub Command2_Click() '取消共享

Dim RetVal As Long
RetVal = Shell("net share AAA /delete", 0) ' Run Calculator.
If RetVal = 0 Then
MsgBox ("Error")
Else
MsgBox ("OK")
End If
End Sub