Share folder and set permission to everyone

[Adebiyi24]

Hello VbForums
I find this code to share a folder at runtime
However access is not granted to everyone.
I mean I can't access the folder from another machine.
Is there a way to grant access to everyone?

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 Command2_Click()
Dim success As Long
               
   success = ShareAdd("\\" & Environ$("COMPUTERNAME"), _
                    Environ$("APPDATA") & "\Test", _
                      "Test", _
                      "", _
                      "")
End Sub

Private Sub Form_Load()

Text1.Text = "\\" & Environ$("COMPUTERNAME")
Text2.Text = "C:\Test\Test"
Text3.Text = "vbnetdemo"
Text4.Text = "VB6 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

[fafalone]

See pebmeisters post here: https://forums.codeguru.com/showthre...ogrammatically

It's a bit of a pain to do in VB, but the post shows you which APIs to call and how to get a SID for 'Everyone'

Additional defs for APIs, UDTs, enums, etc
.., going from twinBASIC to VB6 is easier than the Windows SDK C defs; so I'd recommend my Windows Development Library for a centralized source; https://github.com/fafalone/WinDevLib
Export\Sources\wdAPI.twin, wdDefs.twin, and wdShellCore.twin are online browsable text where you'd find most of the defs if you didn't want to install tB.

[Adebiyi24]

sorry but this is not vb6 code

[fafalone]

No but it tells you what APIs to call with what parameters.

Not everything, especially on a topic like this, has something already written in VB6 you can just copy and paste. But if you bothered to search for the APIs on this site, you'd find examples of many of them you could adjust to replicate what the C++ example is doing, if you needed additional details of how to rewrite API calls.

[Adebiyi24]

Please forgive my weak knowledge.
This is out of my capacities.
sorry sir

[Adebiyi24]

Please forgive my weak knowledge.
This is out of my capacities.
sorry sir

[wqweto]

You can increase your capacities first and then come back to this topic later if you are not in a hurry.

[qvb6]

Another way is use "net" command line. Example:

Shell "net share TestShare=C:\Test /grant:everyone,FULL"

More examples:

https://www.windows-commandline.com/...etwork-shares/

[Adebiyi24]

Another way is use "net" command line. Example:

Shell "net share TestShare=C:\Test /grant:everyone,FULL"

More examples:

https://www.windows-commandline.com/...etwork-shares/

thank you sir
I tried this

Dim command As String

command = Shell("net share TestShare=C:\Test /grant:everyone,FULL")

but still not accessible by everyone

[OptionBase1]

In the world of Windows Permissions, "Everyone" is not all-encompassing.

You may need to look at adding "Guest" access, which allows access across a simple non-domain network where there are just local user accounts on each machine.

[Adebiyi24]

Dim command As String

command = Shell("net share TestShare=C:\Test /grant:Guest,FULL")

Thank you sir but it still inaccessible except the local user.
Windows cannot access ....
You do not have permission ....

[qvb6]

thank you sir
I tried this

Dim command As String

command = Shell("net share TestShare=C:\Test /grant:everyone,FULL")

but still not accessible by everyone

Type the command in Command Prompt, and see if you get any errors. Also, usually you have to have administrative privileges to set permissions. If you run this in VB6 IDE and it's elevated(Used Run as Admin in shortcut properties), then any process you run would be elevated as well. If you compile to EXE, and run that, it may error out unless you use Run as Admin.

[Adebiyi24]

C:\Windows\System32>net share TestShare=C:\Test /grant:Guest,FULL
TestShare was shared successfully.
Yes believe me I have already compiled to EXE and run as admin but still no luck

[dz32]

I have found this useful in the past: command line setacl.exe

https://helgeklein.com/setacl/docume...on-setacl-exe/

[Adebiyi24]

I have found this useful in the past: command line setacl.exe

https://helgeklein.com/setacl/docume...on-setacl-exe/

sorry couldn"t grasp the topic

[OptionBase1]

Dim command As String

command = Shell("net share TestShare=C:\Test /grant:Guest,FULL")

Thank you sir but it still inaccessible except the local user.
Windows cannot access ....
You do not have permission ....

You've only set the share permissions.

It is more complicated than that. You also need to make sure that the Guest account is enabled on the machine. It is almost always disabled by default for security reasons. You also need to make sure that the folder level permissions (what I used to call NTFS permissions) are such that the Guest account has access.

If that is out of your grasp then you are probably trying to tackle something too complicated, and it's also the type of thing that is almost impossible for us to assist with remotely simply through forum posts.

Good luck.

[fafalone]

It was interesting to me so I did an initial port of the C++ example; I haven't tested/debugged yet (there's no syntax errors but haven't run it) but I'm not going to be able to get to that for a few days now so figured I'd post it anyway; if anyone wants to play around with it, the rough draft is in twinBASIC requiring an updated WinDevLib (8.3.444 or newer; bugfix for LookupAccountName). Certainly easier to port to VB6 than C++... I just used a few syntax goodies and LongPtr/UDT subs. After I test/debug I'll post a backport, it's just so much nicer doing initial dev in a modern IDE without having to worry about common Windows API definitions (100% of the ones below were already defined).

    Public Function CreateShareForEveryone(ByVal szName As String, ByVal szPath As String) As Long
        Dim hr As Long
        Dim res As Long 'NET_API_STATUS
        Dim p As SHARE_INFO_502
        Dim sCurrentUser As String = String$(UNLEN, 0)
        Dim dwUserLen As Long = UNLEN + 1
        GetUserNameW StrPtr(sCurrentUser), dwUserLen
        sCurrentUser = Left$(sCurrentUser, dwUserLen - 1)
        Dim pAdminSID As LongPtr
        Dim pAuthenticatedUsersSID As LongPtr
        Dim pCurrentUserSID As LongPtr
        Dim pSystemSID As LongPtr
        Dim pEveryOneSID As LongPtr
        Dim pACL As LongPtr
        Dim ea() As EXPLICIT_ACCESS_W
        Dim SIDAuthNT As SID_IDENTIFIER_AUTHORITY: SIDAuthNT.Value(5) = SECURITY_NT_AUTHORITY
        Dim sidSize As Long = SECURITY_MAX_SID_SIZE
        Dim pSD As LongPtr

        pCurrentUserSID = GetSIDForNamedUserOrGroup(sCurrentUser)
        
    
        ' // Get SID of System
        sidSize = SECURITY_MAX_SID_SIZE
        pSystemSID = LocalAlloc(LPTR, sidSize)
        CreateWellKnownSid(WinLocalSystemSid, 0, pSystemSID, sidSize)
        
        '  // get Sid For EveryOne
        sidSize = SECURITY_MAX_SID_SIZE
        pEveryOneSID = LocalAlloc(LPTR, sidSize)
        CreateWellKnownSid(WinWorldSid, 0, pEveryOneSID, sidSize)
        
        Do
            If AllocateAndInitializeSid(SIDAuthNT, 1, _
                        SECURITY_AUTHENTICATED_USER_RID, _
                        0, 0, 0, 0, 0, 0, 0, _
                        pAuthenticatedUsersSID) = 0 Then
                    hr = Err.LastDllError
                    Exit Do
            End If
            
            ' // Create a SID for the BUILTIN\Administrators group.
            If AllocateAndInitializeSid(SIDAuthNT, 2, _
                        SECURITY_BUILTIN_DOMAIN_RID, _
                        DOMAIN_ALIAS_RID_ADMINS, _
                        0, 0, 0, 0, 0, 0, _
                        pAdminSID) = 0 Then
                    hr = Err.LastDllError
                    Exit Do
            End If
            
            'Dim pSIDs(4) As LongPtr = Array(pCurrentUserSID, pAuthenticatedUsersSID, pAdminSID, pSystemSID, pEveryOneSID)
            Dim pSIDs(4) As LongPtr
            pSIDs(0) = pCurrentUserSID
            pSIDs(1) = pAuthenticatedUsersSID
            pSIDs(2) = pAdminSID
            pSIDs(3) = pSystemSID
            pSIDs(5) = pEveryOneSID
            
            Dim numSids As Long = UBound(pSIDs) + 1
            ReDim ea(UBound(pSIDs))
            
            Dim sidIndex As Long
            Dim i As Long
            For i = 0 To UBound(pSIDs)
                If IsValidSid(pSIDs(i)) = 0 Then Continue For
                
            
                ea(sidIndex).grfAccessPermissions = TRUSTEE_ACCESS_ALL
                ea(sidIndex).grfAccessMode = GRANT_ACCESS
                ea(sidIndex).grfInheritance = SUB_CONTAINERS_AND_OBJECTS_INHERIT
                ea(sidIndex).Trustee.TrusteeForm = TRUSTEE_IS_SID
                ea(sidIndex).Trustee.TrusteeType = TRUSTEE_IS_WELL_KNOWN_GROUP
                ea(sidIndex).Trustee.NameSidOrObject = pSIDs(sidIndex)
                sidIndex += 1
            Next
            
            numSids = sidIndex
            
            '// Create a new ACL that contains the new ACEs.
            If SetEntriesInAclW(numSids, ea(0), 0, pACL) Then
                hr = Err.LastDllError
                Exit Do
            End If
                
            ' // Initialize a security descriptor.
            pSD = LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)

            ' // init the descriptor
            If (InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION) = 0) Then
                hr = Err.LastDllError
                LocalFree(pSD)
                pSD = 0
                Exit Do
            End If

            ' // Add the ACL to the security descriptor.
            If (SetSecurityDescriptorDacl(pSD, _
                  CTRUE, _ /* bDaclPresent flag */
                  pACL, _
                  CFALSE) = 0) Then   ' not a default DACL
                hr = Err.LastDllError
                LocalFree(pSD)
                pSD = 0
                Exit Do
            End If
            ' // Set the Owner
            If (SetSecurityDescriptorOwner(pSD, pCurrentUserSID, CTRUE) = 0) Then
                hr = Err.LastDllError
                LocalFree(pSD)
                pSD = 0
                Exit Do
            End If
            
        Loop While False
        
        If hr = S_OK Then
            p.shi502_netname = StrPtr(szName)
            p.shi502_type = STYPE_DISKTREE
            p.shi502_remark = StrPtr(szName)
            p.shi502_permissions = 0
            p.shi502_max_uses = -1
            p.shi502_current_uses = 0
            p.shi502_path = StrPtr(szPath)
            p.shi502_passwd = 0 '// no password
            p.shi502_security_descriptor = pSD

            res = NetShareAdd(0, 502, p, hr)
            If (res) = 0 Then  
                If (SetFileSecurityW(StrPtr(szPath), DACL_SECURITY_INFORMATION, pSD) = 0) Then
                    hr = Err.LastDllError
                End If
            End If
        
            ' // free SIDs
            If (pAuthenticatedUsersSID) Then FreeSid(pAuthenticatedUsersSID)
            If (pAdminSID) Then FreeSid(pAdminSID)
            ' // free buffers
            If (pEveryOneSID) Then LocalFree(pEveryOneSID)
            If (pCurrentUserSID) Then LocalFree(pCurrentUserSID)
            If (pSystemSID) Then LocalFree(pSystemSID)
            If (pACL) Then LocalFree(pACL)
            ' If (ea)
            '     LocalFree(ea) ;
            If (pSD) Then LocalFree(pSD)
            Return hr
        End If
    End Function
 
    [Description("It is the callers responsibility to call LocalFree on the PSID returned by this function.")]
    Private Function GetSIDForNamedUserOrGroup(sName As String) As LongPtr
        Dim eSidType As SID_NAME_USE = SidTypeUnknown
        Dim dwDomainSz As Long
        Dim dwUserSIDSz As Long = SECURITY_MAX_SID_SIZE
        Dim pDomainName As LongPtr
        Dim pUserSid As LongPtr
        
        If LookupAccountNameW(0, StrPtr(sName), pUserSid, dwUserSIDSz, 0, dwDomainSz, eSidType) = ERROR_INSUFFICIENT_BUFFER Then
            pUserSid = LocalAlloc(LPTR, (dwUserSIDSz + 1) * 2) 'sizeof(TCHAR)) == 2 because we're going explicitly call Unicode ' allocate space For user SID
            pDomainName = String$(dwDomainSz - 1, 0) ' - 1 because it returns the size including the terminating null not counted by VB/tB
            
            If LookupAccountNameW(0, StrPtr(sName), pUserSid, dwUserSIDSz, StrPtr(pDomainName), dwDomainSz, eSidType) Then
                Return pUserSid
            Else
                Debug.Print "LookupAccountName 2nd call error " & Err.LastDllError & ": " & GetSystemErrorString(Err.LastDllError)
            End If
        Else
            Debug.Print "LookupAccountName 1st call error " & Err.LastDllError & ": " & GetSystemErrorString(Err.LastDllError)
        End If
        
    End Function

[Eduardo-]

I have code that does exactly that, but there are several issues to share it.
It is in a large program, and I would have to isolate the code from that, and it could take some time to do it.
It is very old code, and same functions are in Spanish.
I can't test it now because I currently have only one machine, but I guess it must be working because nobody reported that it doesn't work. The last time I tested it was on Windows XP.

Basically it sets the folder proper permissions and creates the net share.
Seeing the little will of the OP to do any effort on his part, I'm not much encouraged to spend time on this issue.
Maybe in a moment that I'm very bored.

[fafalone]

Is it doing it in the same basic way as the code I posted? Seems like it since I'm also setting folder permissions then doing NetShareAdd, though maybe you're just calling out to some command line thing. If it is very similar, maybe just cover what other SIDs are going into the ACL or what the key differences are?

Regardless of what OP wants to do now I'm curious to learn, so any additional info might be good in case the code I wrote has issues when I get some time to test it.

[wqweto]

Btw, I think both steps can be emulated by shelling icacls.exe and net.exe thus sparing the gory API details and not scaring OP out of their capacities.

[fafalone]

Probably but why ask a programming question for an answer of "run a different program that does it for you"?

In that case OP would be better off asking on a Windows tech help forum. Though look at dz32's link; it's not icacls but is that any friendlier? Windows has made this kind of thing absolutely baffling and even I'm often on Google just trying to figure out how to get permissions right through the regular UI, which is a confusing labyrinth of different dialogs that all seem to do what they imply only to find that no, you have to also do this, this, and that through a series of other dialogs just for the most basic things.

[Eduardo-]

Is it doing it in the same basic way as the code I posted? Seems like it since I'm also setting folder permissions then doing NetShareAdd, though maybe you're just calling out to some command line thing. If it is very similar, maybe just cover what other SIDs are going into the ACL or what the key differences are?

Regardless of what OP wants to do now I'm curious to learn, so any additional info might be good in case the code I wrote has issues when I get some time to test it.

Exactly, NetShareAdd and setting folder permissions using code that someone posted on microsoft.public.vb.general.discussion newsgroup (I think it was Mayayana). Here it is: cNTFSPermissions.cls

And in a bas module:

Public Function SetFolderPermissions(nFolderPath As String) As Boolean
    Dim iFP As New cNTFSPermissions
    
    SetFolderPermissions = Not CBool(iFP.SetFolderPermissions(nFolderPath, , "Everyone"))
End Function

Public Function RemoveFolderPermissions(nFolderPath As String) As Boolean
    Dim iFP As New cNTFSPermissions
    
    RemoveFolderPermissions = Not CBool(iFP.SetFolderPermissions(nFolderPath, True, "Everyone"))
End Function

[fafalone]

Yup same concept, thanks

[Eduardo-]

I want to mention that making the net share and/or adding the folder permissions need admin rights (about the permissions I'm sure, about the net share I'm not totally sure but I think so).
So what I did in my program was to run a new instance of the same program as admin (it would show the UAC prompt) with some command line option that indicates to add the share or to remove the share. It does that and then that instance ends.

[wqweto]

Btw, you get the Admin/Elevation/UAC dialogs for free when shelling net.exe/icacls.exe (though repeated in this case)

[Adebiyi24]

Thank you all
Finally I could find my happiness
It worked like a charm