'Shared type Private Const STYPE_ALL As Long = -1Private Const STYPE_DISKTREE As Long = 0Private Const STYPE_PRINTQ As Long = 1Private Const STYPE_DEVICE As Long = 2Private Const STYPE_IPC As Long = 3Private Const STYPE_SPECIAL As Long = & H80000000
'Share permissions Private Const ACCESS_READ As Long = & H1Private Const ACCESS_WRITE As Long = & H2Private Const ACCESS_CREATE As Long = & H4Private Const ACCESS_EXEC As Long = & H8Private Const ACCESS_DELETE As Long = & H10Private Const ACCESS_ATRIB As Long = & H20Private Const ACCESS_PERM As Long = & H40Private Const ACCESS_ALL As Long = Access_read or _ access_create or _ access_exec or _ access_delete or _ access_atrib or _ access_pers
'Sharing information Private Type SHARE_INFO_2 shi2_netname As Long' share name shi2_type As Long 'type shi2_remark As Long' Remarks shi2_permissions As Long 'rights shi2_max_uses As Long' largest user shi2_current_uses As Long 'shi2_path As Long' path shi2_passwd As Long 'password End Type' Set sharing privated lib "Netapi32" _ (Byval ServerName As Long, _ Byval Level As Long, _ BUF as Any, _ Parmerr As long AS Long
'Delete shared Private Declare Function NetShareDel Lib "netapi32.dll" _ (ByVal ServerName As Long, _ ByVal ShareName As Long, _ ByVal dword As Long) As Long' disposed shared Private Sub Command1_Click () Dim success As Long success = ShareAdd ( "// xp", "C: /", "Download", "Resource Directory", ") End Sub
'Delete Sharing Private Sub Command2_Click () DIM SUCCESS AS Long Success = DELSHARE ("// XP", "Download") End Sub
'Set Share (returns 0 for the success of)' Parameters: 'sServer computer name' sSharePath to be shared path 'share name sShareName displayed' sShareRemark Remarks' sSharePw password Private Function ShareAdd (sServer As String, _ sSharePath As String, _ sShareName As String , _ sShareRemark as String, _ sSharePw as String) as Long 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 (sServer) 'transfected into address lngNetname = StrPtr (sShareName) lngPath = StrPtr (sSharePath) 'If there remark information If Len (sShareRemark)> 0 Then lngRemark = StrPtr (sShareRemark) End If' if password If Len (sSharePw)> 0 Then lngPw = StrPtr ( SSHAREPW) EndiffW) Endiff 'Initialization Sharing Information with Si2 .shi2_NetName = LNGNETNAME .SHI2_PATH = LNGPATH .SHI2_REMARK = SNGREMARK .SHI2_TYPE = STYPE_DISKTREE .shi2_permissions = access_all .shi2_max_uses = -1 .shi2_passwd = lngpw end with 'Set sharing (username, sharing type, sharing information,) shareadd = netshareadd (LNGServer, _ 2, _ Si2, _ paramerr) End function' delete sharing ( Return 0 Successful) 'Parameters:' Sserver Computer Name 'SSHARENAME Shared Name Private Function Delshare (SSHERVER AS STRING, _ SSHARENAME AS STRING) AS Long Dim LNGSERVER AS Long' Sim LNGNETNAME AS Long 'shared name
LNGSERVER = STRPTR (SSERVER) 'Transfer LNGNETNAME = Strptr (SSHARENAME)' Delete Sharing Delshare = Netsharedel (LNGServer, LNGNetName, 0)
END FUNCTION
