HOW DO I CHANGE FOLDER SHARING PROPERTIES?

citizen02 · Jan 23, 2000

Does anyone know how I could change the sharing properties of a folder with VB? 

 

Thanks.

DougP · Jan 23, 2000

Look at GetAttr, and SetAttr in VB5 or VB6 
---------------- 
' Assume MYDIR is a directory or folder. 
MyAttr = GetAttr("MYDIR&quot

' Returns 16. 
---------------- 
This example uses the SetAttr statement to set attributes for a file. 
 
SetAttr "TESTFILE", vbHidden ' Set hidden attribute. 
SetAttr "TESTFILE", vbHidden + vbReadOnly ' Set hidden and read-only 
' attributes.

edderic · Jan 27, 2000

Public Declare Function FindFirstFile _ 
Lib "kernel32" Alias "FindFirstFileA" _ 
(ByVal lpFileName As String, _ 
lpFindFileData As WIN32_FIND_DATA) As Long 
 
Public Declare Function FindNextFile _ 
Lib "kernel32" Alias "FindNextFileA" _ 
(ByVal hFindFile As Long, _ 
lpFindFileData As WIN32_FIND_DATA) As Long 
 
Public Declare Function FindClose _ 
Lib "kernel32" (ByVal hFindFile As Long) As Long 
 
Public Const MAX_PATH = 260 
 
Public Type FILETIME 
dwLowDateTime As Long 
dwHighDateTime As Long 
End Type 
 
Public Type WIN32_FIND_DATA 
dwFileAttributes As Long 
ftCreationTime As FILETIME 
ftLastAccessTime As FILETIME 
ftLastWriteTime As FILETIME 
nFileSizeHigh As Long 
nFileSizeLow As Long 
dwReserved0 As Long 
dwReserved1 As Long 
cFileName As String * MAX_PATH 
cAlternate As String * 14 
End Type 
 
Type SHELLEXECUTEINFO 
cbSize As Long 
fMask As Long 
hwnd As Long 
lpVerb As String 
lpFile As String 
lpParameters As String 
lpDirectory As String 
nShow As Long 
hInstApp As Long 
lpIDList As Long 'Optional parameter 
lpClass As String 'Optional parameter 
hkeyClass As Long 'Optional parameter 
dwHotKey As Long 'Optional parameter 
hIcon As Long 'Optional parameter 
hProcess As Long 'Optional parameter 
End Type 
 
Public Const SEE_MASK_INVOKEIDLIST = &HC 
Public Const SEE_MASK_NOCLOSEPROCESS = &H40 
Public Const SEE_MASK_FLAG_NO_UI = &H400 
 
Declare Function ShellExecuteEX _ 
Lib "shell32.dll" Alias "ShellExecuteEx" _ 
(SEI As SHELLEXECUTEINFO) As Long 
 
To a project form add : 
four command buttons (cmdDriveProperties, cmdFolderProperties, cmdFileProperties, cmdEnd) 
two list boxes (FolderList, FilesList) 
a DriveListBox (Drive1) 
a Label (lbCurrPath). 
Add the following to the form: 
 
Option Explicit 
 
Private Sub Form_Load() 
 
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 
LoadFolderInfo 
 
End Sub 
 
 
Private Sub cmdEnd_Click() 
 
Unload Me 
 
End Sub 
 
 
Private Sub cmdFileProperties_Click() 
 
'pass the selected item. Bracketing the list item assures 
'that the text is passed, rather than the list property. 
ShowProperties (FilesList.List(FilesList.ListIndex)) 
 
End Sub 
 
 
Private Sub cmdFolderProperties_Click() 
 
ShowProperties (FolderList.List(FolderList.ListIndex)) 
 
End Sub 
 
 
Private Sub cmdDriveProperties_Click() 
 
ShowProperties (Drive1.List(Drive1.ListIndex)) 
 
End Sub 
 
 
Private Sub Drive1_Change() 
 
'trap a drive not ready error 
On Local Error GoTo Drive1_Error 
 
'change to the selected drive 
ChDrive Drive1.Drive 
 
'get the info 
LoadFolderInfo 
 
Exit Sub 
 
Drive1_Error: 
 
MsgBox "The selected drive is not ready.", _ 
vbCritical, "File and Property Demo" 
 
End Sub 
 
 
Private Sub FilesList_Click() 
 
'only enable the properies button if both an item is 
'selected, and that item is not the 'no files' message 
cmdFileProperties.Enabled = (FilesList.ListIndex > -1) And _ 
(FilesList.List(FilesList.ListIndex)) <> "" 
 
End Sub 
 
 
Private Sub FilesList_DblClick() 
 
'add double-click fuctionality 
ShowProperties (FilesList.List(FilesList.ListIndex)) 
 
End Sub 
 
 
Private Sub FolderList_Click() 
 
cmdFolderProperties.Enabled = (FolderList.ListIndex > -1) 
 
End Sub 
 
 
Private Sub FolderList_DblClick() 
 
'add double-click fuctionality 
Dim newPath As String 
 
newPath = Trim$(FolderList.List(FolderList.ListIndex)) 
 
'Required to validate the path 
If Right$(CurDir, 1) <> "\" Then 
ChDir CurDir + "\" + newPath 
Else: ChDir CurDir + newPath 
End If 
 
'Get items for the new folder 
LoadFolderInfo 
 
End Sub 
 
 
Private Function TrimNull(item As String) 
 
'Return a string without the chr$(0) terminator. 
Dim pos As Integer 
 
pos = InStr(item, Chr$(0)) 
 
If pos Then 
TrimNull = Left$(item, pos - 1) 
Else: TrimNull = item 
End If 
 
 
End Function 
 
 
Private Sub ShowProperties(filename As String) 
 
Dim SEI As SHELLEXECUTEINFO 
Dim r As Long 
 
With SEI 
.cbSize = Len(SEI) 
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI 
.hwnd = Me.hwnd 
.lpVerb = "properties" 
.lpFile = filename 
.lpParameters = vbNullChar 
.lpDirectory = vbNullChar 
.nShow = 0 
.hInstApp = 0 
.lpIDList = 0 
End With 
 
r = ShellExecuteEX(SEI) 
 
End Sub 
 
 
Private Sub LoadFolderInfo() 
 
'Display the contents of a drive/folder. 
 
Dim hFile As Long 
Dim fname As String 
Dim WFD As WIN32_FIND_DATA 
 
lbCurrPath.Caption = " Reading files and directories...." 
FilesList.Clear 
FolderList.Clear 
cmdFileProperties.Enabled = False 
cmdFolderProperties.Enabled = False 
 
'Get the first file in the directory (it will usually return ".&quot

hFile = FindFirstFile("*.*" & Chr$(0), WFD) 
 
'If nothing returned, bail out. 
If hFile < 0 Then Exit Sub 
 
Do 
 
'list the directories in the FolderList. 
If (WFD.dwFileAttributes And vbDirectory) Then 
 
'strip the trailing chr$(0) and add to the folder list. 
FolderList.AddItem TrimNull(WFD.cFileName) 
 
Else 
 
'strip the trailing chr$(0) and add to the file list. 
FilesList.AddItem TrimNull(WFD.cFileName) 
 
End If 
 
 
Loop While FindNextFile(hFile, WFD) 
 
'Close the search handle 
Call FindClose(hFile) 
 
'update both the current path label and the filelist 
If FilesList.ListCount = 0 Then FilesList.AddItem "" 
lbCurrPath.Caption = CurDir 
 
End Sub

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

HOW DO I CHANGE FOLDER SHARING PROPERTIES?

citizen02

Programmer

DougP

MIS

edderic

Programmer

Similar threads

Part and Inventory Search

Sponsor