|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Redes/Comunicações)
|
|
 |
Título da Dica: Compartilhando pastas em Rede através do VB
|
 |
|
|
|
Postada em 7/7/2003 por Ronaldão
'-----------------------------------------------
'Versão para XP (p/ versão Windows 9x veja abaixo)
'-----------------------------------------------
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
'permissions
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
'obtain pointers To the server, share And path
dwServer = StrPtr(sServer)
dwNetname = StrPtr(sShareName)
dwPath = StrPtr(sSharePath)
'If the remark Or password specified,
'obtain pointer To those As well
If Len(sShareRemark) > 0 Then
dwRemark = StrPtr(sShareRemark)
End If
If Len(sSharePw) > 0 Then
dwPw = StrPtr(sSharePw)
End If
'prepare the SHARE_INFO_2 structure
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
'add the share
ShareAdd = NetShareAdd(dwServer, _
2, _
si2, _
parmerr)
End Function
'-----------------------------------------------
'Vale lembrar que este teste foi feito com XP,
'para compartilhamento em Versoes Do Windows 9x
'deve-se utilizar o código abaixo:
'-----------------------------------------------
Option Explicit
Private Const NERR_SUCCESS As Long = 0&
Private Const SHI50F_FULL As Long = 2
Private Const SHI50F_PERSIST As Long = &H100
'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
'permissions
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 Const LM20_NNLEN As Long = 12
Private Const SHPWLEN As Long = 8
Private Type SHARE_INFO_50
shi50_netname(0 To LM20_NNLEN) As Byte
shi50_type As Byte
shi50_flags As Integer
shi50_remark As Long
shi50_Path As Long
shi50_rw_password(0 To SHPWLEN) As Byte
shi50_ro_password(0 To SHPWLEN) As Byte
End Type
Private Declare Function NetShareAdd9x Lib "svrapi" _
Alias "NetShareAdd" _
(pszServer As Any, _
ByVal sLevel As Integer, _
pbBuffer As Any, _
ByVal cbBuffer As Integer) As Long
Private Sub ShareFolder9x(ShareName As String, _
FullPath As String, _
Description As String)
Dim ShareInfo As SHARE_INFO_50
Dim success As Long
Dim AnsiPath() As Byte
Dim AnsiRemark() As Byte
AnsiPath = StrConv(Ucase$(FullPath) & vbNullChar, vbFromUnicode)
AnsiRemark = StrConv(Description & vbNullChar, vbFromUnicode)
With ShareInfo
StringIntoByteArray .shi50_netname, ShareName
.shi50_type = STYPE_DISKTREE
.shi50_flags = SHI50F_FULL + SHI50F_PERSIST
.shi50_remark = VarPtr(AnsiRemark(0))
.shi50_Path = VarPtr(AnsiPath(0))
End With
success = NetShareAdd9x(0, 50, ShareInfo, Len(ShareInfo))
If success <> 0 Then Err.Raise success
End Sub
Private Sub StringIntoByteArray(Bytes() As Byte, Text As String)
Dim Index As Long
For Index = 1 To Len(Text)
Bytes(Index - 1) = Asc(Mid$(Text, Index, 1))
Next Index
Bytes(Index) = Asc(vbNullChar)
End Sub
|
|
|
|
|
