powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Закрытие расшаренных дисков
12 сообщений из 12, страница 1 из 1
Закрытие расшаренных дисков
    #34044653
Kifir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый день!
У меня собственно такая проблема: не могу закрыть расшаренную папку
Помогите разобратся, как закрыть диски обратно
вот код
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
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

...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34044754
Melkiades
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ну раз уж вы нашли функцию NetShareAdd, то могли бы догадаться о существовании NetShareDel.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
Option Explicit
Public Platform As Long 'Platform ID of OS.  1 or 2

'Structure for Getversion
Public Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String *  128       '  Maintenance string for PSS usage
End Type

Public Const STYPE_DISKTREE As Long =  0 
Public Const STYPE_PRINTQ As Long =  1 
Public Const STYPE_DEVICE As Long =  2 
Public Const STYPE_IPC As Long =  3 

'Access types
Public Const ACCESS_READ As Long = &H1
Public Const ACCESS_WRITE  As Long = &H2
Public Const ACCESS_CREATE  As Long = &H4
Public Const ACCESS_EXEC  As Long = &H8
Public Const ACCESS_DELETE As Long = &H10
Public Const ACCESS_ATRIB  As Long = &H20
Public Const ACCESS_PERM  As Long = &H40
Public Const ACCESS_ALL  As Long = &H7F
Public Const WNTYPE_DRIVE  As Long =  1 
Public Const SHI_USES_UNLIMITED  As Long = - 1 

'Info structures for NetShareAdd
Type SHARE_INFO_2
    shi2_netname As String *  14 
    shi2_type As Long
    shi2_remark As String  'Far pointer to string
    shi2_permissions As Long
    shi2_max_uses As Long
    shi2_current_uses As Long
    shi2_path As String    'Far pointer to string
    shi2_passwd As String *  10 
End Type

Type SHARE_INFO_50
    shi50_netname As String
    shi50_type As String
    shi50_flags As Long
    shi50_remark As String
    shi50_path As String
    shi50_rw_password As String
    shi50_ro_password As String
End Type

'ACL for Security Descriptor
Public Type ACL
        AclRevision As Byte
        Sbz1 As Byte
        AclSize As Integer
        AceCount As Integer
        Sbz2 As Integer
End Type

'Security Descriptor for SHARE_INFO_502
Public Type SECURITY_DESCRIPTOR
        Revision As Byte
        Sbz1 As Byte
        Control As Long
        Owner As Long
        Group As Long
        Sacl As ACL
        Dacl As ACL
End Type

Type SHARE_INFO_502
    shi502_netname As String
    shi502_type As Long
    shi502_remark As String
    shi502_permissions As Long
    shi502_max_uses As Long
    shi502_current_uses As Long
    shi502_path As String
    shi502_passwd As String
    shi502_reserved As Long
    shi502_security_descriptor As SECURITY_DESCRIPTOR
End Type

Public Security As SECURITY_DESCRIPTOR

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
                            (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function lstrcpy Lib "kernel32" _
                    (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
'NT
Public Declare Function NetShareDelNT Lib "netapi32.dll" Alias "NetShareDel" _
(ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long
Public Declare Function NetShareAddNT Lib "netapi32.dll" Alias "NetShareAdd" _
                                (ByVal servername As Any, ByVal slevel As Long, _
                                buf As SHARE_INFO_502, ByVal cbbuf As Long) As Long
'9x
Public Declare Function NetShareDel9x Lib "svrapi.dll" Alias "NetShareDel" _
(ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long
Public Declare Function NetShareAdd9x Lib "svrapi.dll" Alias "NetShareAdd" _
(ByVal servername As Any, ByVal slevel As Long, buf As SHARE_INFO_50, ByVal cbbuf As Long) As Long

'====================
'ADD CODE TO FORM:
'====================
Option Explicit
Dim SI2 As SHARE_INFO_2
Dim SI502 As SHARE_INFO_502
Dim SI50 As SHARE_INFO_50
Dim OSVERInfo As OSVERSIONINFO
Dim ShareRemark As String
Dim SharePath As String
Dim nerr As Long
Dim nPath As String
Dim pwd As String
Dim ret As Long
Dim OS As Long
Private Sub Form_Load()
    OSVERInfo.dwOSVersionInfoSize = Len(OSVERInfo)
    OS = GetVersionEx(OSVERInfo)
    Command1.Caption = "Create Share NT"
    Command2.Caption = "Create Share Win9x"
    Command3.Caption = "Delete Share"
End Sub
Private Sub Command1_Click()
'NT
On Error Resume Next
    SetStrings
    nerr = NetShareAddNT( 0 &,  2 , SI502, ret)
    Print nerr
End Sub
Private Sub Command2_Click()
'9x
On Error Resume Next
    SetStrings
    nerr = NetShareAdd9x( 0 &,  50 , SI50, ret)
    Print nerr
End Sub
Private Sub Command3_Click()
'Delete
On Error Resume Next
    If OSVERInfo.dwPlatformId =  1  Then
        nerr = NetShareDel9x( 0 &, nPath,  0 &)
    Else
        nerr = NetShareDelNT( 0 &, nPath,  0 &)
        Print nerr
    End If
End Sub
Public Sub SetStrings()
    If OSVERInfo.dwPlatformId =  1  Then
'9x OS
        nPath = "NewShare"
        ShareRemark = "Remark for new share"
        SharePath = "C:\dos"
        pwd = "Share"
        
        SI50.shi50_netname = nPath
        SI50.shi50_path = SharePath

        SI50.shi50_remark = ShareRemark
        SI50.shi50_type = STYPE_DISKTREE
        SI50.shi50_ro_password = vbNullChar
        SI50.shi50_rw_password = vbNullChar
        
    Else
'NT OS
        nPath = StrConv("NewShare", vbUnicode)
        ShareRemark = StrConv("Remark for new share", vbUnicode)
        SharePath = StrConv("C:\dos", vbUnicode)
        pwd = StrConv("Share", vbUnicode)
    
        SI502.shi502_current_uses =  0 
        SI502.shi502_max_uses =  10 
        SI502.shi502_netname = nPath
        SI502.shi502_passwd = pwd
        SI502.shi502_path = SharePath
        SI502.shi502_permissions = ACCESS_ALL
        SI502.shi502_remark = ShareRemark
        SI502.shi502_reserved =  0 
        SI502.shi502_security_descriptor = Security
        SI502.shi502_type = STYPE_DISKTREE
        
    End If
End Sub

...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34047842
Kifir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спс за код.
Но вот у меня встала проблема... Написал код
форма
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Private Sub Command1_Click()
Dim a As String, b As String
a = "\\" & Environ$("COMPUTERNAME")
b = "C:/4"
Dim nerr As Long
nerr = ShareDel(a, b)

Select Case nerr
Case  0 : MsgBox "Норм !"
Case Else: MsgBox "Ошибка " & nerr
End Select
End Sub
Модуль
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Private Declare Function NetShareDel Lib "netapi32.dll" (ByVal servername As String, ByVal sharename As String, ByVal parm_err As Integer) As Integer


Public Function ShareDel(sServer As String, _
sShareName As String) As Long
Dim dwServer As Long
Dim dwNetname As Long
Dim parmerr As Long
dwServer = StrPtr(sServer)
dwNetname = StrPtr(sShareName)
ShareDel = NetShareDel(dwServer, dwNetname, parmerr)
End Function
И у меня все время ошибка 1113
Подскажите как с этим боротся???
Может я константы не выставил?(если да, то не знаю какие)
P.S. Что я заметил: В api wiever'e нет функций NetShareDel и NetShareAdd
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34048394
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
Public Declare Function NetShareDelNT Lib "netapi32.dll" Alias "NetShareDel" _
(ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34048399
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
b = "C:/4"

может все-таки так:

Код: plaintext
b = "C:\4"
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34048472
Kifir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Итак хочу огласить вердикт.
Сижу уже 4 часа, и вот вроде понял в чем дело.
Вы спросите, зачем я не стал использовать ф-ию NetShareDelNT?
Отвечаю: при ее использовании
Код: plaintext
1.
2.
Public Declare Function NetShareDelNT Lib "netapi32.dll" Alias "NetShareDel" _
(ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long
где servername я использую как написно в примере &0, далее netname и снова &0. В итоге я вызываю ф-ию:
Код: plaintext
1.
2.
3.
Dim a as Long, dwNetname as Long
dwNetname = StrPtr(C:/ 123 )
a = NetShareDelNT(& 0 ,dwNetname,& 0 )
В итоге мне выдается ошибка, хотя католог расшарен. Но что я заметил! Только стоит мне расшарить папку, с помошью ф-ии NetShareAddNT, и потом убрать шару, то непременно все работает.
НО! мне не надо заранее использовать ф-ию NetShareAddNT, а нужно с ходу убирать шару на диске.
Как мне пользоватся только ф-ией NetShareDelNT или NetShareDel ???

Не могу понять, зачем ставится - &0 и что это означает(просто 0 чтоли?)?
Еще не могу понять зачем надо переводить путь к папке, к примеру C:/123 в юникод посредством оператора
Код: plaintext
 StrConv("C:\123", vbUnicode) 
И на последок чем отличается StrConv("C:\123", vbUnicode) от StrPtr("C:\123")?
Помогите разобратся более точнее! Я не знаток vb
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34048577
Melkiades
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
0& - это null в VB.
StrConv("C:\123", vbUnicode) возвращает строку с юникоде, а StrPtr("C:\123") возвращает ссылку на область памяти, где гранится строковая переменная "C:\123".
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34049040
Фотография orunbek
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
На сайте www.allapi.net есть прога API Guide классная прога по API-функциям: справка, готовые примеры и всё такое
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34050439
Kifir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Помогите разобратся, почему функция NetShareDelNt работает только после того как срабатывает ф-ия NetShareAddNt
Как заставить сразу срабатывать ф-ию NetShareDelNt?
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34050808
Фотография orunbek
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а если так:
Код: plaintext
1.
Shell "net share SHARED /d"
где SHARED - имя расшаренного ресурса
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34050919
Kifir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
orunbekа если так:
Код: plaintext
1.
Shell "net share SHARED /d"
где SHARED - имя расшаренного ресурса
Не работает ((
...
Рейтинг: 0 / 0
Закрытие расшаренных дисков
    #34052447
Фотография orunbek
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
у меня прекрасно работает а вы имя шары правильно указываете? сначала в консоле проверьте работу команды net shae del, ну и потом когда разберетесь в консоле перенести эту команду в VB через shell
...
Рейтинг: 0 / 0
12 сообщений из 12, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Закрытие расшаренных дисков
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]