Как расшарить папку при помощи NetShareAdd

Автор: Randy Birch

Компилятор: Visual Basic

Функция NetShareAdd даёт в доступ ресурсы сервера или рабочей станции. Для использования функции NetShareAdd необходимы права администратора.

Параметр sServer это указатель на строку, содержащую имя удалённого сервера, на котором будет выполнена функция. Эта строка должна обязательно начинаться с символов \\. Если параметр будет задан пустым, то в качестве сервера будет использоваться текущий компьютер. На NT / 2000 / XP для расшаривания ресурса могут использоваться две структуры: SHARE_INFO_2 либо SHARE_INFO_502. В win9x для этого используется структура SHARE_INFO_50. К тому же для win9k параметр структуры shi50_path должен содержать только заглавные буквы.

Добавьте на форму кнопку (Command1), пять текстовых полей (Text1 - Text5) и следующий код:

Option Explicit

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

'разрешения
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 Sub Form_Load()
  
   Text1.Text = "\\" & Environ$("COMPUTERNAME")
   Text2.Text = "c:\program files\adobe"
   Text3.Text = "vbnetdemo"
   Text4.Text = "VBnet demo test share"
   Text5.Text = ""
   
End Sub


Private Sub Command1_Click()

   Dim success As Long
               
   success = ShareAdd(Text1.Text, _
                      Text2.Text, _
                      Text3.Text, _
                      Text4.Text, _
                      Text5.Text)
                      
   Select Case success
      Case 0:    MsgBox "share created successfully!"
      Case 2118: MsgBox "share name already exists"
      Case Else: MsgBox "create error " & success
   End Select

End Sub


Private Function ShareAdd(sServer As String, _
                          sSharePath As String, _
                          sShareName As String, _
                          sShareRemark As String, _
                          sSharePw As String) As Long
   
   Dim dwServer   As Long
   Dim dwNetname  As Long
   Dim dwPath     As Long
   Dim dwRemark   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(sShareRemark) > 0 Then
      dwRemark = StrPtr(sShareRemark)
   End If
   
   If Len(sSharePw) > 0 Then
      dwPw = StrPtr(sSharePw)
   End If
      
  'подготавливаем структуру SHARE_INFO_2
   With si2
      .shi2_netname = dwNetname
      .shi2_path = dwPath
      .shi2_remark = dwRemark
      .shi2_type = STYPE_DISKTREE
      .shi2_permissions = ACCESS_ALL
      .shi2_max_uses = -1
      .shi2_passwd = dwPw
   End With
                          
  'расшариваем ресурс
   ShareAdd = NetShareAdd(dwServer, _
                          2, _
                          si2, _
                          parmerr)
                          
End Function