Option Explicit

'NetShareAdd在Win9x下是放在SrvAPI.dll中，而在NT下则入在NETAPI32.DLL中。
'
'在Win98下应使用结构SHARE_INFO_50
'在NT下应使用结构SHARE_INFO_2 和SHARE_INFO_502

Private Declare Function NetShareAdd Lib "srvapi.dll" (ByVal ServerName As Long, ByVal level As Long, buf As Any, parmerr As Long) As Long
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

Const STYPE_ALL = -1
Const STYPE_DISKTREE = 0
Const STYPE_PRINTQ = 1
Const STYPE_DEVICE = 2
Const STYPE_IPC = 3
Const STYPE_SPECIAL = &H80000000

Const ACCESS_READ = &H1
Const ACCESS_WRITE = &H2
Const ACCESS_CREATE = &H4
Const ACCESS_EXEC = &H8
Const ACCESS_DELETE = &H10
Const ACCESS_ATRIB = &H20
Const ACCESS_PERM = &H40
Const ACCESS_ALL = ACCESS_READ Or ACCESS_WRITE Or ACCESS_CREATE Or ACCESS_EXEC Or ACCESS_DELETE Or ACCESS_ATRIB Or ACCESS_PERM

'为指定的计算机添加共享
'Server 为计算机名
'SharePath 为共享路径
'ShareName 为共享名
'ShareRemark 为备注
'SharePw 为密码
Function AddShare(Server As String, SharePath As String, ShareName As String, ShareRemark As String, SharePw As String) As Boolean
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(Server)
lngNetname = StrPtr(ShareName)
lngPath = StrPtr(SharePath)

If Len(ShareRemark) > 0 Then
lngRemark = StrPtr(ShareRemark)
End If

If Len(SharePw) > 0 Then
lngPw = StrPtr(SharePw)
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

If NetShareAdd(lngServer, 2, si2, parmerr) = 0 Then
AddShare = True
Else
AddShare = False
End If
End Function

Private Sub Command1_Click()
' MkDir "d:\123"
AddShare "server", "d:\123", "123", "例子", ""
End Sub