Windows下访问共享的解决⽅案（整理版本）'2000 下⽤API来实现⽬录共享及删除共享
'共享类型
Private Const STYPE_ALL      As Long = -1
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
'权限
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_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
'设置共享
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 NetShareDel Lib "netapi32.dll" _
(ByVal ServerName As Long, _
ByVal ShareName As Long, _
ByVal dword As Long) As Long
'sSharePath      要共享路径
'sShareName      显⽰的共享名
'sShareRemark    备注
'sSharePw        密码
Private Function ShareAdd(sServer As String, _                          sSharePath As String, _
sShareName As String, _
sShareRemark As String, _
sSharePw As String) As Long
Dim lngServer  As Long
Dim lngNetname  As Long
Dim lngPath    As Long
Dim lngRemark  As Long
Dim lngPw      As Long
Dim parmerr    As Long
Dim si2        As SHARE_INFO_2
lngServer = StrPtr(sServer)      '转成地址
lngNetname = StrPtr(sShareName)
lngPath = StrPtr(sSharePath)
'如果有备注信息
If Len(sShareRemark) > 0 Then
lngRemark = StrPtr(sShareRemark)
End If
'如果有密码
If Len(sSharePw) > 0 Then
lngPw = StrPtr(sSharePw)
End If
'初始化共享信息
With si2
.shi2_netname = lngNetname
.shi2_path = lngPath
.shi2_remark = lngRemark
.shi2_type = STYPE_DISKTREE
.
shi2_permissions = ACCESS_ALL
.shi2_max_uses = -1
.shi2_passwd = lngPw
End With
'设置共享(⽤户名，共享类型，共享信息,)
ShareAdd = NetShareAdd(lngServer, _
2, _
si2, _
parmerr)
End Function
'sShareName    共享名
Private Function DelShare(sServer As String, _
sShareName As String) As Long
Dim lngServer  As Long      '计算机名
Dim lngNetname  As Long      '共享名
lngServer = StrPtr(sServer)      '转成地址
lngNetname = StrPtr(sShareName)
'删除共享
DelShare = NetShareDel(lngServer, lngNetname, 0)
End Function
（感谢源代码提供者）
由于Win98与Win2000的不同，响应的代码也不⼀样.
以下是win9x的
在98下建⽴访问类型为完全的访问密码为“”的共享⽂件夹
Option Explicit
Private Const NERR_SUCCESS As Long = 0&
' Share types
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
' Flags
Private Const SHI50F_RDONLY = &H1
Private Const SHI50F_FULL = &H2
ssh工具windowsPrivate Const SHI50F_DEPENDSON = SHI50F_RDONLY + SHI50F_FULL
Private Const SHI50F_ACCESSMASK = SHI50F_RDONLY + SHI50F_FULL
Private Const SHI50F_PERSIST = &H100 ' Partage persistant
Private Const SHI50F_SYSTEM = &H200 ' Partage cach?
' Permissions (Win ME/NT/2000/XP)
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
' Win 9x
Private Type SHARE_INFO_50
shi50_netname(0 To 12) As Byte 'LM20_NNLEN + 1
shi50_type As Byte 'EShareType
shi50_flags As Integer
shi50_remark As Long
shi50_Path As Long
shi50_rw_password(0 To 8) As Byte 'SHPWLEN + 1
shi50_ro_password(0 To 8) As Byte 'SHPWLEN + 1
End Type
' Quelle systeme d'exploitation
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function NetShareAdd95 Lib "SVRAPI" Alias "NetShareAdd" (ByVal servername As String, ByVal level As Integer, ByVal buf As Long, ByVal cbBuffer As Integer) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Sub cmdCreateShare_Click()
Dim lngSuccess As Long
' Create the share
'要添加上相应的textbox
lngSuccess = ShareAdd(UCase(txtComputerName.Text), UCase(txtLocalPath.Text), UCase(txtShareN
ame.Text), txtShareDesc.Text)
'lngSuccess = ShareAdd(txtComputerName.Text, txtLocalPath.Text, txtShareName.Text, txtShareDesc.Text, txtSharePassRo.Text, txtSharePassRw.Text)
Select Case lngSuccess
Case 0:    ' Share created successfully
Case 2118'共享名已经存在，就改改共享名，我这随便补了⼀个1
lngSuccess = ShareAdd(UCase(txtComputerName.Text), UCase(txtLocalPath.Text), UCase(txtShareName.Text) + "1", txtShareDesc.Text)
Case Else: MsgBox "Create error number " & lngSuccess, vbCritical, "Error"
End Select
End Sub
Private Function ShareAdd(sServer As String, sSharePath As String, sShareName As String, sShareR
emark As String) As Long
Dim si50 As SHARE_INFO_50
Dim iErrParam As Integer
Dim lpszPath() As Byte
Dim lpszRemark() As Byte
Dim intFlags As Integer
intFlags = SHI50F_FULL Or SHI50F_PERSIST 'mode normal le partage est visible sur la machine ' flags = SHI50F_FULL Or SHI50F_PERSIST Or SHI50F_SYSTEM 'mode syst鑝e partage invisible lpszPath = StrConv(sSharePath, vbFromUnicode) & vbNullChar
lpszRemark = StrConv(sShareRemark, vbFromUnicode) & vbNullChar
With si50
StrToByte sShareName, VarPtr(.shi50_netname(0))
.shi50_type = STYPE_DISKTREE
.shi50_remark = VarPtr(lpszRemark(0))
.shi50_Path = VarPtr(lpszPath(0))
StrToByte "", VarPtr(.shi50_ro_password(0))
StrToByte "", VarPtr(.shi50_rw_password(0))
.shi50_flags = intFlags
End With
ShareAdd = NetShareAdd95("", 50, ByVal VarPtr(si50), LenB(si50))
End Function
Private Sub StrToByte(strInput As String, ByVal lpByteArray As Long)
Dim lpszInput() As Byte
lpszInput = StrConv(strInput, vbFromUnicode) & vbNullChar
CopyMemory ByVal lpByteArray, lpszInput(0), UBound(lpszInput)
End Sub
2 连接远程共享
下⼀步就是连接
Windows对于共享的访问是这样的(记不清出了)
a 判断远程共享是否有密码(guest是否允许)
b 判断远程共享的密码是否与当前帐户⼀致，或者是否为空密码
c ⽤⽤户名密码连接，并且记录下来这个密码,⽅便以后使⽤
d 如果需要映射⽹络驱动器，那么映射⼀个盘符
可以利⽤Net use 命令，但是 win98跟win2000不⼀样,net use 也不⼀样
以下是代码实现
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
把下⾯代码放到module中
Option Explicit
Const WN_Success = &H0
Const WN_Not_Supported = &H1
Const WN_Net_Error = &H2
Const WN_Bad_Pointer = &H4
Const WN_Bad_NetName = &H32
Const WN_Bad_Password = &H6
Const WN_Bad_Localname = &H33
Const WN_Access_Denied = &H7
Const WN_Out_Of_Memory = &HB
Const WN_Already_Connected = &H34
Public ErrorNum As Long
Public ErrorMsg As String
Public rc As Long
Private Const ERROR_NO_CONNECTION = 8
Private Const ERROR_NO_DISCONNECT = 9

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。