急，请问怎样建立共享文件夹，在线等待

Question

[名称]           建立磁盘/目录的資源分享/共享[语言种类]       Visual Basic[类别一]         VBAPI[类别二]         网络通信[类别三]         系统操控[数据来源]       www.vbguide.com.tw[保存时间]       2002-06-18[关键字一]       资源共享[关键字二]       磁盘/目录[关键字三]       空[内容简介]       如何判断共享文件夹的存在，并且把共享文件夹设置为不共享！  
1要求得知共享文件夹的真正路径和文件名，以及虚拟文件名。  
2如何不需要重起机器，就可以把共享文件夹设置为不共享！  [源代码内容]在【檔案總管】或【我的電腦】中，我們都可以直接在磁碟機或目錄上按滑鼠右鍵，選【內容】，在【資源分享】頁中設定磁碟機或目錄的資源分享，如圖：  
 
 　90.09.15  加註：    
　此範例只適用於  Win95／98／Me！  
   
 
我在集團的資訊部門工作，要處理一二十家以上的公司系統，在正常的狀況下，為了方便，我們在機器交給使用者使用時，會替他們將某個磁碟機或某個目錄設定可以資源分享，但是並不是每個使用者都喜歡開放自己的電腦讓別人存取，於是他們便會將資源分享的功能取消，造成資訊人員些許不方便。  
 
這時候，也不必和使用者爭得臉紅脖子粗的，反正山不轉路轉，我們就不知不覺地，讓使用者自己在莫名其妙的情形下，按照您的意思，在某個磁碟機或某個目錄設定您想要設定的資源分享，然後又神不知鬼不覺地取消資源分享！  
 
要怎麼做呢？其實很簡單，就是將設定/取消資源分享的功能寫在  VB  程式中，像人事差勤系統是每個使用者都要使用的系統，我們就在這些系統的  VB  程式中，去設定/取消資源分享！而且使用者完全沒有感覺！  
 
下面這個模組檔案中  (.bas檔)  已經有完整的宣告及完成的二個模組，只要呼叫這二個模組，就可以建立/取消磁碟機或目錄的資料分享：  
 
 Source  Code  下載    
 
這二個模組說明如下：  
 
Public  Function  CreateShare  _            '  建立資源分享模組  
(ByVal  sSharePath  As  String,  _          '  完整路徑  
ByVal  sShareName  As  String,  _           '  資源分享名稱  
ByVal  sRe  As  String,  _              '  說明  
ByVal  sROPass  As  String,  _              '  唯讀密碼  
ByVal  sRWPass  As  String)  As  Long       '  完整存取密碼        
 
Public  Function  DeleteShare  _             '  取消資源分享模組  
(ByVal  sShareName  As  String)  As  Long    '  資源分享名稱  
 
呼叫範例如下：  
 
Private  Sub  Command1_Click()  
       '  建立資源分享  CDISK  
       CreateShare    "C:\  ",    "CDISK  ",    "小紀的  C  磁碟機  ",    "JWHR  ",    "JWHRW  "  
End  Sub  
 
Private  Sub  Command2_Click()  
       '  取消資源分享  CDISK  
       DeleteShare    "CDISK  "  
End  Sub  
註：就像一般教人家做壞事的書或電視節目一樣，我也要聲明一下：  
註：以上方式請用於正途  (系統需要)，請勿使用以上方法來不當竊取不該看的檔案！
     以上代码保存于： SourceCode Explorer(源代码数据库)
           复制时间： 2002-10-12 23:06
           软件版本： 1.0.745
           软件作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729

Answer 1

[名称]           创建共享目录[语言种类]       Visual Basic[类别一]         网络通信[类别二]         系统操控[类别三]         VBAPI[数据来源]       未知[保存时间]       2002-06-18[关键字一]       网络[关键字二]       共享目录[关键字三]       API[内容简介]       空[源代码内容]Private Const NERR_SUCCESS As Long = 0&
Private Const STYPE_ALL       As Long = -1  'note: my const
Private Const STYPE_DISKTREE  As Long = 0
Private Const STYPE_PRINTQ    As Long = 1
Private Const STYPE_DEVICE    As Long = 2
Private Const STYPE_IPC       As Long = 3
Private Const STYPE_SPECIAL   As Long = &H80000000
'permissions
Private Const ACCESS_READ     As Long = &H1
Private Const ACCESS_WRITE    As Long = &H2
Private Const ACCESS_CREATE   As Long = &H4
Private Const ACCESS_EXEC     As Long = &H8
Private Const ACCESS_DELETE   As Long = &H10
Private Const ACCESS_ATRIB    As Long = &H20
Private Const ACCESS_PERM     As Long = &H40
Private Const ACCESS_ALL      As Long = ACCESS_READ Or _
                                        ACCESS_WRITE Or _
                                        ACCESS_CREATE Or _
                                        ACCESS_EXEC Or _
                                        ACCESS_DELETE Or _
                                        ACCESS_ATRIB Or _
                                        ACCESS_PERM
Private 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 Type
Private Declare Function NetShareAdd Lib "netapi32" _
  (ByVal servername As Long, _
   ByVal level As Long, _
   buf As Any, _
   parmerr As Long) As Long
Private Declare Function NetShareDelete Lib "netapi32()" (ByVal servername As Long, _
   ByVal level As Long, _
   buf As Any, _
   parmerr As Long) As LongPrivate Function ShareAdd(sServer As String, _
                          sSharePath As String, _
                          sShareName As String, _
                          sShareRe As String, _
                          sSharePw As String) As Long
   Dim dwServer   As Long
   Dim dwNetname  As Long
   Dim dwPath     As Long
   Dim dwRe   As Long
   Dim dwPw       As Long
   Dim parmerr    As Long
   Dim si2        As SHARE_INFO_2
   dwServer = StrPtr(sServer)
   dwNetname = StrPtr(sShareName)
   dwPath = StrPtr(sSharePath)
   If Len(sShareRe) > 0 Then
      dwRe = StrPtr(sShareRe)
   End If
   If Len(sSharePw) > 0 Then
      dwPw = StrPtr(sSharePw)
   End If
   With si2
      .shi2_netname = dwNetname
      .shi2_path = dwPath
      .shi2_re = dwRe
      .shi2_type = STYPE_DISKTREE
      .shi2_permissions = &H1 'ACCESS_READ
      .shi2_max_uses = -1
      .shi2_passwd = dwPw
   End With
   ShareAdd = NetShareAdd(dwServer, 2, si2, parmerr)
End FunctionPrivate Sub Command1_Click()
Dim fpath As String
Dim sharename As String
fpath = "e:\"
sharename = "1234"ShareAdd "", fpath, sharename, "", ""
End Sub
     以上代码保存于： SourceCode Explorer(源代码数据库)
           复制时间： 2002-10-12 23:06
           软件版本： 1.0.745
           软件作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729

Answer 2

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 3

使用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