[求助]设置共享~~~

Question

使用shell命令：(测试环境：NT4.0/Win2000)
Option ExplicitPrivate 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 SubPrivate 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

Answer 1

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 = 12Public Type wshare_info_1 'USE FOR WIN98
    shi1_netname(13)  As Byte
    shi1_pad1 As Byte
    shi1_type As Integer
    shi1_re As Byte
End Type
Public Type Share_Info_1 'Use for WINNT/2000
     shi1_netname As Long
     shi1_type As Long
     shi1_re As Long
End TypePublic Type SHARE_INFO_2
  shi2_netname As Long
  shi2_type As Long
  shi2_re 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 TypePublic Type MungeLong
     x As Long
     dummy As Integer
End TypePublic Type MungeInt
   XLo As Integer
   XHi As Integer
   dummy As Integer
 End Type
Public Const WM_SETTEXT = &HCPublic 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 LongDim 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_re = 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_re = 0retVal = 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, strNetShareRe 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 MungeIntBufLen = -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)
            strNetShareRe = Left(SNArray, StrLen(TempPtr.x))
            
          
            List1.AddItem strNetShareName
            
          Next i
          
          result = NetApiBufferFree(bufptr)
      Loop Until entriesread = totalentriesEnd Sub

Answer 2

参见精华区：http://www.csdn.net/expert/topic/315/315197.xml?temp=.5654413