Public Enum EShareType
STYPE_DISKTREE = 0 'Disk drive
STYPE_PRINTQ = 1 'Print queue
STYPE_DEVICE = 2 'Communication device
STYPE_IPC = 3 'Interprocess Communication (IPC)
STYPE_SPECIAL = &H80000000
End Enum
Private Type SHARE_INFO_50 'Used for Windows '95 only
shi50_netname(0 To 12) As Byte 'LM20_NNLEN + 1
shi50_type As Byte 'EShareType
shi50_flags As Integer
shi50_remark As Long
shi50_Path As Long
shi50_rw_password(0 To 8) As Byte 'SHPWLEN + 1
shi50_ro_password(0 To 8) As Byte 'SHPWLEN + 1
End Type
Private Const SHI50F_RDONLY = &H1
Private Const SHI50F_FULL = &H2
Private Const SHI50F_DEPENDSON = SHI50F_RDONLY + SHI50F_FULL
Private Const SHI50F_ACCESSMASK = SHI50F_RDONLY + SHI50F_FULL
Private Const SHI50F_PERSIST = &H100 'Keep share after a reboot
Private Const SHI50F_SYSTEM = &H200 'System share (hidden)
Private Declare Function NetShareAdd95 Lib "svrapi" Alias "NetShareAdd" _
(ByVal ServerName As String, _
ByVal Level As Integer, _
ByVal buf As Long, _
ByVal cbBuffer As Integer) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Sub StrToByte(strInput As String, ByVal lpByteArray As Long)
Dim lpszInput() As Byte
lpszInput = StrConv(strInput, vbFromUnicode) & vbNullChar
CopyMemory ByVal lpByteArray, lpszInput(0), UBound(lpszInput)
End Sub
Public Sub ShareResource(ServerName As String, Path As String, ShareName As String, Remark As String)
Dim si50 As SHARE_INFO_50
Dim iErrParam As Integer
Dim lpszPath() As Byte
Dim lpszRemark() As Byte
Dim lReturnValue As Long
ShareName = UCase(ShareName)
Path = UCase(Path)
lpszPath = StrConv(Path, vbFromUnicode) & vbNullChar
lpszRemark = StrConv(Remark, vbFromUnicode) & vbNullChar
With si50
StrToByte ShareName, VarPtr(.shi50_netname(0))
.shi50_type = 0
.shi50_remark = VarPtr(lpszRemark(0))
.shi50_Path = VarPtr(lpszPath(0))
'Note: I hardcoded it for no password.
'Add one to the input parameters if you'd
'like for this function to support it...
StrToByte "", VarPtr(.shi50_ro_password(0))
StrToByte "", VarPtr(.shi50_rw_password(0))
.shi50_flags = SHI50F_RDONLY + SHI50F_PERSIST
End With
lReturnValue = NetShareAdd95(ServerName, 50, ByVal VarPtr(si50), LenB(si50))
Select Case lReturnValue
Case 0 'Yay
Case 2102 'NERR_NERR_NetNotStarted
Err.Raise lReturnValue, "ShareResource", "Networking has not been started on this computer."
Case 2114 'NERR_ServerNotStarted
Err.Raise lReturnValue, "ShareResource", "The server has not been started on this computer."
Case 2310 'NERR_NetNameNotFound
Err.Raise lReturnValue, "ShareResource", "The computer " & ServerName & " was not found."
Case 124 'ERROR_INVALID_LEVEL
Err.Raise lReturnValue, "ShareResource", "Invalid level for server_info structure."
Case 2123 'NERR_BufTooSmall
Err.Raise lReturnValue, "ShareResource", "The buffer size specified for the server_info structure was too small."
Case 2127 'NERR_RemoteErr
Err.Raise lReturnValue, "ShareResource", "There has been an error on the remote computer."
Case 2351 'NERR_InvalidComputer
Err.Raise lReturnValue, "ShareResource", "Invalid server name. If the server is a Windows '9X machine, check to make sure file sharing is enabled."
Case 234 'ERROR_MORE_DATA
Err.Raise lReturnValue, "ShareResource", "More data is available."
Case 87 'ERROR_INVALID_PARAMETER
Err.Raise lReturnValue, "ShareResource", "An invalid parameter has been passed to NetShareAdd."
Case 2118
Case Else 'Some other error
Err.Raise lReturnValue, "ShareResource", "Unable to create share."
End Select
End Sub