04-22-2012, 08:23 AM
|
 |
Junior Contributor
|
|
Join Date: Jul 2002
Location: Area 51 A
Posts: 366
|
|
Set Folder Permissions
|
I need my VB6 app to modify the permissions of the root folder (most likely Program Files (x86)) on Windows 7 to full control for the current user. I seem to be able to accomplish this using the code below when running the source inside the VB6 environment, however when I package it up and install it on the system it doesn't seem to work. Any ideas why this happening?
Modify User Permissions on App Load
Function to Modify the User Permissions
Code:
Private Function SetUserPermissions()
Dim strHomeFolder, strHome, strUser
Dim intRunError, objShell, objFSO
strHomeFolder = App.Path
strUser = CurrentUser
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strHomeFolder) Then
intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls """ & strHomeFolder & """ /e /c /g " & strUser & ":F ", 2, True)
'Wscript.Echo "The File " & strHomeFolder & ". Permissions changed to Every One."
If intRunError <> 0 Then
MsgBox "Error assigning permissions for user " & strUser & " to " & strHomeFolder, vbCritical + vbOKOnly, "User Permissions"
End If
End If
End Function
Function to Get Current User
Code:
Public Function CurrentUser() As String
Dim strBuff As String * 255
Dim X As Long
CurrentUser = ""
X = GetUserName(strBuff, Len(strBuff) - 1)
If X > 0 Then
'Look for Null Character, usually included
X = InStr(strBuff, vbNullChar)
'Trim off buffered spaces too
If X > 0 Then
CurrentUser = UCase(Left$(strBuff, X - 1)) 'UCase is optional ;)
Else
CurrentUser = UCase(Left$(strBuff, X))
End If
End If
End Function
|
|
Linear Mode
