Option Explicit'共享類型 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_re 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
'設置共享 Private Sub Command1_Click() Dim success As Long Dim pcname As String Dim sdisk As String Dim sfolder As String sdisk = Combo1.Text pcname = txtpc_name.Text sfolder = txtshareF.Text If sdisk = "" Or pcname = "" Or sfolder = "" Then MsgBox "不能為空!", vbInformation Exit Sub End If success = ShareAdd(Trim("\\" & pcname), Trim(sdisk & ":\"), sfolder, "資源目錄", "") If success = 0 Then MsgBox "共享成功" Else MsgBox "共享不成功" End If
End Sub'刪除共享 Private Sub Command2_Click() Dim success As Long Dim pcname As String Dim sdisk As String Dim sfolder As String sdisk = Combo1.Text pcname = txtpc_name.Text sfolder = txtshareF.Text If sdisk = "" Or pcname = "" Or sfolder = "" Then MsgBox "不能為空!", vbInformation Exit Sub End If success = DelShare("\\" & pcname, sfolder) If success = 0 Then MsgBox "刪除共享成功", vbInformation Else MsgBox "刪除共享未成功", vbInformation End If End Sub'置共享(返回0 為成功) '參數 'sServer 計算机名 'sSharePath 要共享路徑 'sShareName 顯示的共享名 'sShareRe 備注 'sSharePw 密碼 Private Function ShareAdd(sServer As String, _ sSharePath As String, _ sShareName As String, _ sShareRe As String, _ sSharePw As String) As Long
Dim lngServer As Long Dim lngNetname As Long Dim lngPath As Long Dim lngRe As Long Dim lngPw As Long Dim parmerr As Long Dim si2 As SHARE_INFO_2
End Function'刪除共享(返回0 表示成功) '參數: 'sServer 計算机名 '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 FunctionPrivate Sub Form_Load() With Combo1 .AddItem "c" .AddItem "d" .AddItem "e" .AddItem "f" .AddItem "g" .AddItem "h" .AddItem "i" End With End Sub'輸入對方 的計算機名稱 '輸入共享成的文件夾,如:aa '選擇要進入的盤符,如:d盤 '在開始---->運行裡輸入\\計算機名稱\\aa即可
在浏览器输入
\\ip\c$
然后输入administertor 和对应的密码,就可以在不共享的情况下访问c盘
依次类推
\\ip\d$
\\ip\d$
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_re 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
'設置共享
Private Sub Command1_Click() Dim success As Long
Dim pcname As String
Dim sdisk As String
Dim sfolder As String
sdisk = Combo1.Text
pcname = txtpc_name.Text
sfolder = txtshareF.Text
If sdisk = "" Or pcname = "" Or sfolder = "" Then
MsgBox "不能為空!", vbInformation
Exit Sub
End If
success = ShareAdd(Trim("\\" & pcname), Trim(sdisk & ":\"), sfolder, "資源目錄", "")
If success = 0 Then
MsgBox "共享成功"
Else
MsgBox "共享不成功"
End If
End Sub'刪除共享
Private Sub Command2_Click()
Dim success As Long
Dim pcname As String
Dim sdisk As String
Dim sfolder As String
sdisk = Combo1.Text
pcname = txtpc_name.Text
sfolder = txtshareF.Text
If sdisk = "" Or pcname = "" Or sfolder = "" Then
MsgBox "不能為空!", vbInformation
Exit Sub
End If
success = DelShare("\\" & pcname, sfolder)
If success = 0 Then
MsgBox "刪除共享成功", vbInformation
Else
MsgBox "刪除共享未成功", vbInformation
End If
End Sub'置共享(返回0 為成功)
'參數
'sServer 計算机名
'sSharePath 要共享路徑
'sShareName 顯示的共享名
'sShareRe 備注
'sSharePw 密碼
Private Function ShareAdd(sServer As String, _
sSharePath As String, _
sShareName As String, _
sShareRe As String, _
sSharePw As String) As Long
Dim lngServer As Long
Dim lngNetname As Long
Dim lngPath As Long
Dim lngRe 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(sShareRe) > 0 Then
lngRe = StrPtr(sShareRe)
End If
'如果有密碼
If Len(sSharePw) > 0 Then
lngPw = StrPtr(sSharePw)
End If
'初始化共享信息
With si2
.shi2_netname = lngNetname
.shi2_path = lngPath
.shi2_re = lngRe
.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'刪除共享(返回0 表示成功)
'參數:
'sServer 計算机名
'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 FunctionPrivate Sub Form_Load()
With Combo1
.AddItem "c"
.AddItem "d"
.AddItem "e"
.AddItem "f"
.AddItem "g"
.AddItem "h"
.AddItem "i"
End With
End Sub'輸入對方 的計算機名稱
'輸入共享成的文件夾,如:aa
'選擇要進入的盤符,如:d盤
'在開始---->運行裡輸入\\計算機名稱\\aa即可
Private Sub Form_Load()
WebBrowser1.Navigate "\\局域网机器名称"
End Sub